{-# LANGUAGE QuasiQuotes #-}
module Triangle where

import Graphics.Rendering.OpenGL as GL
import GI.Gtk as Gtk
import GI.Gdk.Objects

import Control.Concurrent
import Control.Monad
import Data.ByteString (ByteString)
import Foreign.Marshal (newArray)
import Foreign.Ptr
import Foreign.Storable

import UtilGL

fragment_source :: ByteString
fragment_source = [glslFragment|
#version 330
in vec4 inputColor;
out vec4 outputColor;
void main() {
outputColor = vec4(1.0f, 0.0f, 0.0f, 0.0f); //constant red. I know it's a poor shader
}
|]

vertex_source :: ByteString
vertex_source = [glslVertex|
#version 330
in vec4 position;
void main() { gl_Position =  position; }
|]

data State = State
    { stProgram :: Maybe Program
    , stBuffer  :: Maybe BufferObject
    }

initState :: IO (MVar State)
initState = newMVar State
    { stProgram = Nothing
    , stBuffer  = Nothing
    }

drawTriangle :: MVar State -> IO ()
drawTriangle svar = withMVar svar $ \st -> do
    forM_ ((,) <$> stProgram st <*> stBuffer st) $ \(program,position_buffer) -> do

    -- Use our shaders
    GL.currentProgram $= Just program

    -- Use the vertices in our buffer
    GL.bindBuffer ArrayBuffer $= Just position_buffer
    GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Enabled
    GL.vertexAttribPointer (GL.AttribLocation 0) $= (GL.ToFloat,VertexArrayDescriptor 4 GL.Float 0 nullPtr)
    -- Draw the three vertices as a triangle
    GL.drawArrays Triangles 0 3

    -- We finished using the buffers and program
    GL.vertexAttribArray (GL.AttribLocation 0) $= GL.Disabled
    GL.bindBuffer ArrayBuffer $= Nothing

render :: MVar State -> GLArea -> GLContext -> IO Bool
render svar w gl = do
    putStrLn "render!"
    me <- gLAreaGetError w
    maybe id (\e _ -> print e) me $ do
        -- Clear the viewport
        GL.clearColor $= GL.Color4 0 0 0 1
        GL.clear [ColorBuffer]
        -- draw our object
        drawTriangle svar
        GL.flush

    return True

realize :: MVar State -> GLArea -> IO ()
realize svar w = do
    putStrLn "realize!"
    gLAreaMakeCurrent w
    me <- gLAreaGetError w
    maybe id (\e _ -> print e) me $ do
        ctx <- gLAreaGetContext w

        -- We only use one VAO, so we always keep it bound
        vao <- GL.genObjectName
        GL.bindVertexArrayObject $= Just vao

        (vertex_data_sz,vertex_data) <- do
            ptr <- newArray [ GL.Vertex4  0      0.5       0  1
                            , GL.Vertex4  0.5    (-0.366)  0  1
                            , GL.Vertex4  (-0.5) (-0.366)  0  1
                            ]
            return ( fromIntegral $ 3 * sizeOf (GL.Vertex4 0 0 0 (0 :: Float) )
                   , ptr :: Ptr (GL.Vertex4 Float) )

        -- This is the buffer that holds the vertices
        buffer <- GL.genObjectName
        GL.bindBuffer ArrayBuffer $= Just buffer
        GL.bufferData ArrayBuffer $= (vertex_data_sz, vertex_data, StaticDraw)
        GL.bindBuffer ArrayBuffer $= Nothing

        mfrag <- makeShader FragmentShader fragment_source
        mvert <- makeShader VertexShader vertex_source
        mprog <- makeProgram mfrag mvert

        modifyMVar_ svar $ \_ -> return State
            { stProgram = mprog
            , stBuffer  = Just buffer
            }

        return ()


unrealize :: MVar State -> GLArea -> IO ()
unrealize _ _ = do
    putStrLn "unrealize!"