{-# LANGUAGE QuasiQuotes, LambdaCase #-}
module Triangle where

import Data.GI.Base.ManagedPtr (newManagedPtr)
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!"

createContext :: MVar State -> GLArea -> IO GLContext
createContext st glarea = do
    st <- readMVar st
    widgetGetWindow glarea >>= \case
        Just win -> windowCreateGlContext win
        Nothing  -> do
            putStrLn "createContext: GLArea has no window."
            mptr <- newManagedPtr nullPtr (return ())
            return $ GLContext mptr