content: module Main where
  
  import Graphics.Rendering.OpenGL as GL
  import Graphics.UI.GLFW as GLFW
  import Control.Monad (forever)
  import System.Exit (exitSuccess)
  import Foreign.Marshal.Array (withArray)
  import Foreign.Ptr (plusPtr, nullPtr, Ptr)
  import Foreign.Storable (sizeOf)
  import NGL.LoadShaders
  import Graphics.GLUtil (readTexture, texture2DWrap)
  
  data Descriptor = Descriptor VertexArrayObject ArrayIndex NumArrayIndices
  data Shape = Square    (Float, Float)   Float
             deriving Show
  
  verticies :: [GLfloat]
  verticies =
    [
      0.5,  0.5, 0.0,  -- Top Right
      0.5, -0.5, 0.0,  -- Bottom Right
     -0.5, -0.5, 0.0,  -- Bottom Left
     -0.5,  0.5, 0.0   -- Top Left    
    ] 
  
  uv :: [GLfloat]
  uv =
    [
      1.0, 1.0,  -- Top Right
      1.0, 0.0,  -- Bottom Right
      0.0, 0.0,  -- Bottom Left
      0.0, 1.0   -- Top Left    
    ] 
  
  indices :: [GLuint]
  indices =
    [          -- Note that we start from 0!
      0, 1, 3, -- First Triangle
      1, 2, 3  -- Second Triangle
    ]
       
  keyPressed :: GLFW.KeyCallback 
  keyPressed win GLFW.Key'Escape _ GLFW.KeyState'Pressed _ = shutdown win
  keyPressed _   _               _ _                     _ = return ()
                                                                    
  shutdown :: GLFW.WindowCloseCallback
  shutdown win = do
    GLFW.destroyWindow win
    GLFW.terminate
    _ <- exitSuccess
    return ()                                                                  
     
  resizeWindow :: GLFW.WindowSizeCallback
  resizeWindow _ w h =
      do
        GL.viewport   $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
        GL.matrixMode $= GL.Projection
        GL.loadIdentity
        GL.ortho2D 0 (realToFrac w) (realToFrac h) 0   
  
  openWindow :: String -> (Int, Int) -> IO GLFW.Window
  openWindow title (sizex,sizey) = do
      GLFW.init
      GLFW.defaultWindowHints
      GLFW.windowHint (GLFW.WindowHint'ContextVersionMajor 4)
      GLFW.windowHint (GLFW.WindowHint'ContextVersionMinor 5)
      GLFW.windowHint (GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core)
      GLFW.windowHint (GLFW.WindowHint'Resizable False)
      Just win <- GLFW.createWindow sizex sizey title Nothing Nothing
      GLFW.makeContextCurrent (Just win)
      GLFW.setWindowSizeCallback win (Just resizeWindow)
      GLFW.setKeyCallback win (Just keyPressed)
      GLFW.setWindowCloseCallback win (Just shutdown)
      return win
  
  closeWindow :: GLFW.Window -> IO ()
  closeWindow win = do
      GLFW.destroyWindow win
      GLFW.terminate
  
  display :: IO ()
  display = do
       inWindow <- openWindow "NGL is Not GLoss" (512,512)
       descriptor <- initResources verticies indices
       onDisplay inWindow descriptor
       closeWindow inWindow
                   
  onDisplay :: GLFW.Window -> Descriptor -> IO ()
  onDisplay win descriptor@(Descriptor triangles firstIndex numVertices) = do
    GL.clearColor $= Color4 0 0 0 1
    GL.clear [ColorBuffer]
    bindVertexArrayObject $= Just triangles
    --drawArrays Triangles firstIndex numVertices
    drawElements Triangles 6 GL.UnsignedInt nullPtr
    GLFW.swapBuffers win
  
    forever $ do
       GLFW.pollEvents
       onDisplay win descriptor                 
  
  -- | Init Resources
  ---------------------------------------------------------------------------
  initResources :: [GLfloat] -> [GLuint] -> IO Descriptor
  initResources vs idx =
    do
  
      -- | VBO
      -- || VAO
      triangles <- genObjectName
      bindVertexArrayObject $= Just triangles
  
      let numVertices = length vs
      vertexBuffer <- genObjectName
      bindBuffer ArrayBuffer $= Just vertexBuffer
      withArray vs $ \ptr -> do
          let sizev = fromIntegral (numVertices * sizeOf (head vs))
          bufferData ArrayBuffer $= (sizev, ptr, StaticDraw)
  
      let firstIndex = 0
          vPosition = AttribLocation 0
      vertexAttribPointer vPosition $=
          (ToFloat, VertexArrayDescriptor 3 Float 0 (bufferOffset firstIndex))
      vertexAttribArray vPosition $= Enabled
  
      -- || EBO
      elementBuffer <- genObjectName
      bindBuffer ElementArrayBuffer $= Just elementBuffer
      
      let numIndices = length indices
      withArray idx $ \ptr -> do
          let indicesSize = fromIntegral $ sizeOf (0 :: GLuint) * (length indices)
          bufferData ElementArrayBuffer $= (indicesSize, ptr, StaticDraw)
  
      -- || UVs
  
      textureBuffer <- genObjectName
      bindBuffer ArrayBuffer $= Just textureBuffer
      withArray uv $ \ptr -> do
          let size = fromIntegral (numVertices * sizeOf (head uv))
          bufferData ArrayBuffer $= (size, ptr, StaticDraw)
      let firstIndex = 0
          uvCoords = AttribLocation 1
      vertexAttribPointer uvCoords $=
          (ToFloat, VertexArrayDescriptor 2 Float 0 (bufferOffset firstIndex))
      vertexAttribArray uvCoords $= Enabled
  
      -- || Assign Textures
      let tex = "test.png"
      tx <- loadTex tex
      texture Texture2D $= Enabled
      activeTexture $= TextureUnit 0
      textureBinding Texture2D $= Just tx    
  
      -- || Shaders
      program <- loadShaders [
          ShaderInfo VertexShader (FileSource "Shaders/shader.vert"),
          ShaderInfo FragmentShader (FileSource "Shaders/shader.frag")]
      currentProgram $= Just program
  
      -- || Unload buffers
      bindVertexArrayObject $= Nothing
      bindBuffer ElementArrayBuffer $= Nothing
  
      return $ Descriptor triangles firstIndex (fromIntegral numIndices)
  
  bufferOffset :: Integral a => a -> Ptr b
  bufferOffset = plusPtr nullPtr . fromIntegral
  
  loadTex :: FilePath -> IO TextureObject
  loadTex f = do t <- either error id <$> readTexture f
                 textureFilter Texture2D $= ((Linear', Nothing), Linear')
                 texture2DWrap $= (Repeated, ClampToEdge)
                 return t
  ---------------------------------------------------------------------------
  
  main :: IO ()
  main =
    do
      display
  