{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Main where

import Codec.Picture             as Juicy
import Control.Concurrent
import Data.Word
import Data.Function
import qualified Data.Map.Strict as Map
import qualified Data.Vector     as V
import GI.Gdk.Objects
import GI.GLib.Constants
import GI.Gtk                    as Gtk hiding (main)
import LambdaCube.GL             as LC
import LambdaCube.GL.Mesh        as LC
import System.IO
import System.IO.Error

import GLWidget
import LambdaCubeWidget
import TimeKeeper

type State = (TextureData, TimeKeeper, TickCallbackHandle)

uploadState :: IsWidget glarea => DynamicImage -> glarea -> GLStorage -> IO State
uploadState img glarea storage = do
    -- upload geometry to GPU and add to pipeline input
    LC.uploadMeshToGPU triangleA >>= LC.addMeshToObjectArray storage "objects" []
    LC.uploadMeshToGPU triangleB >>= LC.addMeshToObjectArray storage "objects" []
    -- load image and upload texture
    texture <- LC.uploadTexture2DToGPU img
    -- setup FrameClock
    tm <- newTimeKeeper
    tickcb <- widgetAddTickCallback glarea (tick tm)
    return (texture,tm,tickcb)

destroyState :: GLArea -> State -> IO ()
destroyState glarea (texture,tm,tickcb) = do
    widgetRemoveTickCallback glarea tickcb

setUniforms :: glctx -> GLStorage -> State -> IO ()
setUniforms gl storage (texture,tm,_) = do
    t <- withMVar (tmSeconds tm) return
    LC.updateUniforms storage $ do
      "diffuseTexture" @= return texture
      "time" @= return (realToFrac t :: Float)

main :: IO ()
main = do
    m <- do
        mimg <- Juicy.readImage "logo.png" `catchIOError` \e -> return $ Left (show e)
        mpipeline <- loadPipeline "hello.json" $ do
                        defObjectArray "objects" Triangles $ do
                            "position"  @: Attribute_V2F
                            "uv"        @: Attribute_V2F
                        defUniforms $ do
                            "time"           @: Float
                            "diffuseTexture" @: FTexture2D
        return $ (,) <$> mimg <*> mpipeline
    either (\e _ -> hPutStrLn stderr e) (&) m $ \(logo,pipeline) -> do
        app <- do
            mvar <- newEmptyMVar
            return $ \glarea -> LCMethods
                { lcRealized     = mvar
                , lcUploadState  = uploadState logo glarea
                , lcDestroyState = destroyState glarea
                , lcSetUniforms  = setUniforms
                , lcPipeline     = pipeline
                }

        runGLApp return (lambdaRender app glmethods)

-- geometry data: triangles
triangleA :: LC.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 :: LC.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
    }