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

import Codec.Picture             as Juicy
import Control.Concurrent
import Control.Monad
import Data.Word
import Data.Function
import Data.Text (Text)
import Data.Map.Strict (Map)
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 Numeric.LinearAlgebra hiding ((<>))
import System.Environment
import System.IO
import System.IO.Error

import GLWidget
import LambdaCube.GL.HMatrix
import LambdaCubeWidget
import TimeKeeper
import LoadMesh
import InfinitePlane
import MtlParser (ObjMaterial(..))
import Matrix

-- State created by uploadState.
data State = State
    { stTimeKeeper   :: TimeKeeper
    , stTickCallback :: TickCallbackHandle
    }

addOBJToObjectArray :: GLStorage -> String -> [(GPUMesh, Maybe Text)] -> Map Text (ObjMaterial,TextureData) -> IO [LC.Object]
addOBJToObjectArray storage slotName objMesh mtlLib = forM objMesh $ \(mesh,mat) -> do
  obj <- LC.addMeshToObjectArray storage slotName ["diffuseTexture","diffuseColor"] mesh
         -- diffuseTexture and diffuseColor values can change on each model
  case mat >>= flip Map.lookup mtlLib of
    Nothing -> return ()
    Just (ObjMaterial{..},t) -> LC.updateObjectUniforms obj $ do
      "diffuseTexture" @= return t -- set model's diffuse texture
      "diffuseColor" @= let (r,g,b) = mtl_Kd in return (V4 r g b mtl_Tr)
  return obj


uploadState :: IsWidget glarea => MeshData -> glarea -> GLStorage -> IO State
uploadState obj glarea storage = do
    -- load OBJ geometry and material descriptions
    (objMesh,mtlLib) <- uploadOBJToGPU obj
    -- load materials textures
    gpuMtlLib <- uploadMtlLib mtlLib
    -- add OBJ to pipeline input
    addOBJToObjectArray storage "objects" objMesh gpuMtlLib
    -- grid plane
    uploadMeshToGPU xyplane >>= addMeshToObjectArray storage "plane" []

    -- setup FrameClock
    tm <- newTimeKeeper
    tickcb <- widgetAddTickCallback glarea (tick tm)

    return State
        { stTimeKeeper   = tm
        , stTickCallback = tickcb
        }

destroyState :: GLArea -> State -> IO ()
destroyState glarea st = do
    widgetRemoveTickCallback glarea (stTickCallback st)

deg30 :: Float
deg30 = pi/6

setUniforms :: glctx -> GLStorage -> State -> IO ()
setUniforms gl storage st = do
    t <- getSeconds $ stTimeKeeper st
    let tf = realToFrac t :: Float
        rot = rotMatrixZ (-tf) <> rotMatrixX (-tf)
        pos = rot #> fromList [0,0,10]
        up = rot #> fromList [0,1,0]
        cam = lookat pos 0 up
        aspect = 1
        proj = perspective 0.1 100 deg30 aspect
        mvp = proj <> cam

    LC.updateUniforms storage $ do
      "cam" @= return (mvp :: Matrix Float)

main :: IO ()
main = do
    m <- do
        objName <- head . (++ ["cube.obj"]) <$> getArgs
        mobj <- loadOBJ objName
        mpipeline <- loadPipeline "hello_obj2.json" $ do
          defObjectArray "objects" Triangles $ do
            "position"  @: Attribute_V4F
            "normal"    @: Attribute_V3F
            "uvw"       @: Attribute_V3F
          defObjectArray "plane" Triangles $ do
            "position"  @: Attribute_V4F
          defUniforms $ do
            "cam"             @: M44F
            "diffuseTexture"  @: FTexture2D
            "diffuseColor"    @: V4F
        return $ (,) <$> mobj <*> mpipeline
    either (\e _ -> hPutStrLn stderr e) (&) m $ \(obj,pipeline) -> do
        app <- do
            mvar <- newEmptyMVar
            return $ \glarea -> LCMethods
                { lcRealized     = mvar
                , lcUploadState  = uploadState obj glarea
                , lcDestroyState = destroyState glarea
                , lcSetUniforms  = setUniforms
                , lcPipeline     = pipeline
                }

        runGLApp return (lambdaRender app glmethods)
            { glTitle = "LambdaCube 3D DSL OBJ viewer"
            }