{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Haskengl.IO (openWindow, shutdownWindow, view) where

-- IMPORTS --

import qualified Graphics.Rendering.OpenGL as GL
import           Graphics.Rendering.OpenGL         (($=))
import qualified Graphics.GLUtil           as GLU  (readTexture, texture2DWrap)
import qualified Graphics.UI.GLFW          as GLFW
import qualified Language.GLSL             as GLSL
import qualified Linear                    as L
import           Linear.V4                         (V4(..))

import Control.Exception
import Control.Monad
import Data.Text             (unpack)
import Foreign.Ptr
import Foreign.Marshal.Array
import Foreign.Storable

import Relude

import Haskengl.IO.Shaders.LoadShaders
import Haskengl.IO.Shaders.Shaders
import Haskengl.Types
import Haskengl.Math.Transforms

-- VIEW --

backgroundColor :: GL.Color4 GL.GLfloat
backgroundColor = GL.Color4 1 0 1 1

view :: GLFW.Window -> DisplayableObjects -> Model -> IO ()
view window objects model = do
  GL.clearColor $= backgroundColor
  GL.clear [GL.ColorBuffer]
  displayObjects objects
  GLFW.swapBuffers window
  GLFW.pollEvents

-- SHADER STUFF --

projection :: L.M44 GL.GLfloat
projection = L.perspective (45 * 3.141592653 / 180) 1 0.1 100

displayObjects :: DisplayableObjects -> IO (DisplayableObjects)
displayObjects [] = return []
displayObjects ((DisplayableObject vao _ numVertices _ primitiveMode):objects) = do
  GL.bindVertexArrayObject $= Just vao
  GL.drawArrays primitiveMode 0 numVertices
  displayObjects objects

-- INIT RENDERER --

bufferOffset :: Integral a => a -> Ptr b
bufferOffset integral = plusPtr nullPtr $ fromIntegral integral

toGLMatrix :: L.M44 GL.GLfloat -> [GL.GLfloat]
toGLMatrix (V4 (V4 c00 c01 c02 c03)
                  (V4 c10 c11 c12 c13)
                  (V4 c20 c21 c22 c23)
                  (V4 c30 c31 c32 c33)) =
  [ c00, c01, c02, c03
  , c10, c11, c12, c13
  , c20, c21, c22, c23
  , c30, c31, c32, c33
  ]

verticesArray :: [GL.Vertex3 GL.GLfloat]
verticesArray =
  [ GL.Vertex3 0.3    0.3    0.5
  , GL.Vertex3 (-0.3) 0.3    0
  , GL.Vertex3 0.3    (-0.3) 0
  , GL.Vertex3 (-0.3) (-0.3) (-0.5)
  ]

testArray :: [GL.Vertex3 GL.GLfloat]
testArray =
  [ GL.Vertex3 1.5 1.5 0
  , GL.Vertex3 0.5 1.5 0
  , GL.Vertex3 1.5 0.5 0
  , GL.Vertex3 0.5 0.5 0
  ]

verticesUVArray :: [GL.Vertex2 GL.GLfloat]
verticesUVArray =
  [ GL.Vertex2 0 0
  , GL.Vertex2 1 0
  , GL.Vertex2 0 1
  , GL.Vertex2 1 1
  ]

generateRGBA :: Int -> [GL.Color4 GL.GLfloat]
generateRGBA i =
  take i $ cycle rgba

rgba :: [GL.Color4 GL.GLfloat]
rgba =
  [ GL.Color4 1.0 0.0 0.0 1.0
  , GL.Color4 0.0 1.0 0.0 1.0
  , GL.Color4 0.0 0.0 1.0 1.0
  ]

sizeOfArray :: (Storable a, Num b) => [a] -> b
sizeOfArray [] = 0
sizeOfArray (x:xs) = fromIntegral $ (*) ( 1 + length xs) $ sizeOf x

createVBO :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.AttribLocation -> IO GL.BufferObject
createVBO array numComponents attribLocation = do
  buffer <- GL.genObjectName
  GL.bindBuffer GL.ArrayBuffer $= Just buffer
  withArray
    array
    $ \ptr ->
        GL.bufferData GL.ArrayBuffer $= (sizeOfArray array, ptr, GL.StaticDraw)
  GL.vertexAttribPointer attribLocation $=
    ( GL.ToFloat
    , GL.VertexArrayDescriptor
        numComponents
        GL.Float
        0
        (bufferOffset 0)
    )
  GL.vertexAttribArray attribLocation $= GL.Enabled
  return buffer

createDisplayableObject :: (Storable (a GL.GLfloat), Vertex (a GL.GLfloat)) => [a GL.GLfloat] -> GL.NumComponents -> GL.PrimitiveMode -> IO DisplayableObject
createDisplayableObject array numComponents primitiveMode = do
  vao <- GL.genObjectName
  GL.bindVertexArrayObject $= Just vao
  vbo_0 <- createVBO array numComponents $ GL.AttribLocation 0
  vbo_1 <- createVBO (generateRGBA $ length array) 4 $ GL.AttribLocation 1
  vbo_2 <- createVBO verticesUVArray 2 $ GL.AttribLocation 2
  return
    (DisplayableObject
      vao
      (AbsoluteObject $ map (AbsolutePoint . toPoint) array)
      (fromIntegral $ length array)
      numComponents
      primitiveMode
    )

loadTexture :: FilePath -> IO GL.TextureObject
loadTexture f = do
  Right t <- GLU.readTexture f
  GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Nearest)
  GLU.texture2DWrap $= (GL.Repeated, GL.ClampToEdge)
  return t

initResources :: GLFW.Window -> IO DisplayableObjects
initResources window = do
  -- init objects

  verticesObject <- createDisplayableObject verticesArray 3 GL.TriangleStrip
  testObject <- createDisplayableObject testArray 3 GL.TriangleStrip

  putStrLn (unpack $ GLSL.generateGLSL vertShader)
  putStrLn (unpack $ GLSL.generateGLSL fragShader)

  GL.activeTexture $= GL.TextureUnit 0
  let tex = "assets/flag.png"
  tx <- loadTexture tex
  GL.texture GL.Texture2D $= GL.Enabled
  GL.textureBinding GL.Texture2D $= Just tx

  -- load shaders
  program <- loadShaders
    [ ShaderInfo GL.VertexShader (StringSource $ unpack $ GLSL.generateGLSL vertShader)
    , ShaderInfo GL.FragmentShader (StringSource $ unpack $ GLSL.generateGLSL fragShader)
    ]

  GL.currentProgram $= Just program

  GLFW.swapBuffers window
  GLFW.swapBuffers window
  GLFW.swapBuffers window
  (w, h) <- GLFW.getFramebufferSize window

  let
    perspectiveMatrix = toGLMatrix $ L.perspective (78 * 3.141592653 / 180) ((fromIntegral w) / (fromIntegral h)) 0.1 100 L.!*! L.lookAt (L.V3 0 0 (-2)) (L.V3 0 0 0) (L.V3 0 1 0)
  putStrLn $ show perspectiveMatrix

  let
    projectionMatrix =
      [ 1, 0, 0.0, 0.0
      , 0, 1, 0.0, 0.0
      , 0, 0, 1.0, 0.3
      , 0, 0, (-0.3), 1.0] :: [GL.GLfloat]

  projection <- GL.newMatrix GL.ColumnMajor perspectiveMatrix :: IO (GL.GLmatrix GL.GLfloat)
  location0 <- GL.get $ GL.uniformLocation program "projection"
  GL.uniform location0 $= projection

  location1 <- GL.get $ GL.uniformLocation program "tex"
  GL.uniform location1 $= (GL.TextureUnit 0)

  putStrLn $ show projection
  putStrLn $ show location0

  return [verticesObject, testObject]

-- INPUT --

keyPressed :: GLFW.KeyCallback
keyPressed window GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdownWindow window
keyPressed _ _ _ _ _ = return ()

-- WINDOW --

openWindow :: String -> IO (GLFW.Window, DisplayableObjects)
openWindow
  title
  = do
    GLFW.init
    GLFW.defaultWindowHints
    GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4)
    GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5)
    GLFW.windowHint (GLFW.WindowHint'Samples (Just 16))
    GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core)
    monitor <- GLFW.getPrimaryMonitor
    Just window <- GLFW.createWindow 256 256 title monitor Nothing
    GLFW.makeContextCurrent (Just window)
    GLFW.setWindowCloseCallback window (Just shutdownWindow)
    GLFW.setWindowSizeCallback window (Just resizeWindow)
    GLFW.setKeyCallback window (Just keyPressed)
    objects <- initResources window
    return (window, objects)

shutdownWindow :: GLFW.WindowCloseCallback
shutdownWindow window =
  do
    closeWindow window
    _ <- exitSuccess
    return ()

resizeWindow :: GLFW.WindowSizeCallback
resizeWindow _ w h =
  do
    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))

closeWindow :: GLFW.Window -> IO ()
closeWindow window =
  do
    GLFW.destroyWindow window
    GLFW.terminate
