{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings #-}
import Control.Concurrent

-- import "GLFW-b" Graphics.UI.GLFW as GLFW
import qualified Graphics.UI.GLUT as GLFW -- lie
import qualified Graphics.UI.GLUT as GLUT -- truth
import Graphics.UI.GLUT (Window)
import qualified Data.Map as Map
import qualified Data.Vector as V

import LambdaCube.GL as LambdaCubeGL -- renderer
import LambdaCube.GL.Mesh as LambdaCubeGL

import Codec.Picture as Juicy

import Data.Aeson
import qualified Data.ByteString as SB

----------------------------------------------------
--  See:  http://lambdacube3d.com/getting-started
----------------------------------------------------

main :: IO ()
main = do
    Just pipelineDesc <- decodeStrict <$> SB.readFile "hello.json"

    win <- initWindow "LambdaCube 3D DSL Hello World" 640 640

    -- setup render data
    let inputSchema = makeSchema $ do
          defObjectArray "objects" Triangles $ do
            "position"  @: Attribute_V2F
            "uv"        @: Attribute_V2F
          defUniforms $ do
            "time"           @: Float
            "diffuseTexture" @: FTexture2D

    storage <- LambdaCubeGL.allocStorage inputSchema

    -- upload geometry to GPU and add to pipeline input
    LambdaCubeGL.uploadMeshToGPU triangleA >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
    LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []

    -- load image and upload texture
    Right img <- Juicy.readImage "logo.png"
    textureData <- LambdaCubeGL.uploadTexture2DToGPU img

    -- allocate GL pipeline
    renderer <- LambdaCubeGL.allocRenderer pipelineDesc
    LambdaCubeGL.setStorage renderer storage >>= \case -- check schema compatibility
      Just err -> putStrLn err
      Nothing  -> do qsig <- newMVar False
                     GLUT.keyboardMouseCallback GLUT.$= Just (keyCB qsig)
                     loop qsig
        where loop qsig = do
                -- update graphics input
                -- GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
                GLUT.get GLUT.windowSize >>= \(GLUT.Size w h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
                LambdaCubeGL.updateUniforms storage $ do
                  "diffuseTexture" @= return textureData
                  "time" @= do
                              -- Just t <- GLFW.getTime
                              Just t <- Just . (/ (1000.0 :: Double)) . fromIntegral <$> GLUT.elapsedTime
                              return (realToFrac t :: Float)
                -- render
                LambdaCubeGL.renderFrame renderer
                -- GLFW.swapBuffers win
                GLUT.swapBuffers
                -- GLFW.pollEvents
                GLUT.mainLoopEvent

                -- let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
                -- escape <- keyIsPressed Key'Escape
                escape <- withMVar qsig return
                if escape then return () else loop qsig

              keyCB :: MVar Bool -> GLUT.KeyboardMouseCallback
              keyCB qsig key keyState mods pos= do
                cw <- GLUT.get GLUT.currentWindow
                case (keyState,key,cw) of
                    (GLUT.Down,GLUT.Char 'q',Just cw) -> do
                        modifyMVar_ qsig (const $ return True)
                        GLUT.destroyWindow cw
                    (GLUT.Down,_,_)-> GLUT.postRedisplay Nothing
                    _ -> return ()

    LambdaCubeGL.disposeRenderer renderer
    LambdaCubeGL.disposeStorage storage
    GLFW.destroyWindow win
    -- GLFW.terminate

-- geometry data: triangles
triangleA :: LambdaCubeGL.Mesh
triangleA = Mesh
    { mAttributes   = Map.fromList
        [ ("position",  A_V2F $ V.fromList [V2 1 1, V2 1 (-1), V2 (-1) (-1)])
        , ("uv",        A_V2F $ V.fromList [V2 1 1, V2 0 1, V2 0 0])
        ]
    , mPrimitive    = P_Triangles
    }

triangleB :: LambdaCubeGL.Mesh
triangleB = Mesh
    { mAttributes   = Map.fromList
        [ ("position",  A_V2F $ V.fromList [V2 1 1, V2 (-1) (-1), V2 (-1) 1])
        , ("uv",        A_V2F $ V.fromList [V2 1 1, V2 0 0, V2 1 0])
        ]
    , mPrimitive    = P_Triangles
    }

initWindow :: String -> Int -> Int -> IO Window
initWindow title width height = do
    {-
    GLFW.init
    GLFW.defaultWindowHints
    mapM_ GLFW.windowHint
      [ WindowHint'ContextVersionMajor 3
      , WindowHint'ContextVersionMinor 3
      , WindowHint'OpenGLProfile OpenGLProfile'Core
      , WindowHint'OpenGLForwardCompat True
      ]
    Just win <- GLFW.createWindow width height title Nothing Nothing
    GLFW.makeContextCurrent $ Just win
    -}
    (progname,args) <- GLUT.getArgsAndInitialize
    win <- GLUT.createWindow title
    GLUT.actionOnWindowClose GLUT.$=! GLUT.MainLoopReturns
    return win