{-# LANGUAGE OverloadedStrings #-}
module LambdaHello where

import GI.Gtk as Gtk
import GI.Gdk.Objects
import GI.GLib.Constants

import Data.Int
import qualified Graphics.Rendering.OpenGL as GL
import Data.Function
import Control.Concurrent
import LambdaCube.GL as LambdaCubeGL
import LambdaCube.GL.Mesh as LambdaCubeGL
import LambdaCube.IR
import Codec.Picture as Juicy
import Data.Aeson as JSON
import qualified Data.ByteString as SB
import System.IO.Error
import qualified Data.Map as Map
import qualified Data.Vector as V

-- import qualified Backend as RF
import LambdaCube.GL as RF
import LambdaCube.GL.Type
import LambdaCube.Gtk

data State = State
    { stConfig     :: Config
    , stRealized   :: MVar Realized
    , stSeconds    :: MVar Double
    , stFirstFrame :: MVar Int64
    }

initState :: IO State
initState = do
    cfg <- either fail return =<< loadConfig
    r <- newEmptyMVar
    s <- newMVar 0.0
    ff <- newMVar 0
    return State
        { stConfig     = cfg
        , stRealized   = r
        , stSeconds    = s
        , stFirstFrame = ff
        }


render :: State -> GLArea -> GLContext -> IO Bool
render st w gl = do
    mr <- tryTakeMVar (stRealized st)
    maybe (\_ -> putStrLn "Not realized!") (&) mr $ \r -> do
        renderer <- fixupRenderTarget (rRenderer r)

        -- Load input to pipeline.
        -- GLFW.getWindowSize win >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
        (wd,ht) <- do Just win <- getGLContextWindow gl
                      wd <- windowGetWidth win
                      ht <- windowGetHeight win
                      -- print (wd,ht)
                      return (fromIntegral wd,fromIntegral ht)
        LambdaCubeGL.setScreenSize (rStorage r) wd ht
        t <- withMVar (stSeconds st) return
        LambdaCubeGL.updateUniforms (rStorage r) $ do
          "diffuseTexture" @= return (rTexture r)
          "time" @= return (realToFrac t :: Float)

        -- putStrLn "render!"
        -- GL.clearColor GL.$= GL.Color4 0 255 0 1
        -- GL.clear [GL.ColorBuffer]
        RF.renderFrame renderer
        -- GL.flush
        putMVar (stRealized st) r
    return True

data Realized = Realized
    { rStorage  :: GLStorage
    , rTexture  :: TextureData
    , rRenderer :: GLRenderer
    }

tick :: State -> Widget -> FrameClock -> IO Bool
tick st w clock = do
    Just win <- widgetGetWindow w
    windowInvalidateRect win Nothing False
    micros <- frameClockGetFrameTime clock
    ff <- modifyMVar (stFirstFrame st) $ \prev ->
        if prev == 0 then return (micros, micros)
                     else return (prev, prev)
    secs <- modifyMVar (stSeconds st) $ \_ -> do
        let secs = fromIntegral (micros - ff) / 1000000.0
        return (secs,secs)
    -- putStrLn $ "tick! " ++ show (micros,secs)
    return SOURCE_CONTINUE

realize :: State -> GLArea -> IO ()
realize st w = gLAreaMakeCurrent w >> gLAreaGetError w >>= \me -> maybe id (\e _ -> print e) me $ do
    let cfg = stConfig st

    _ <- tryTakeMVar (stRealized st)

    storage <- LambdaCubeGL.allocStorage (cfgSchema cfg)

    -- 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
    texture <- LambdaCubeGL.uploadTexture2DToGPU (cfgLogo cfg)

    renderer <- LambdaCubeGL.allocRenderer (cfgPipeline cfg)

    compat <- LambdaCubeGL.setStorage renderer storage -- check schema compatibility

    putMVar (stRealized st) $ Realized storage texture renderer
    -- GL.flush
    putStrLn "realize!"
    maybe id (\e _ -> putStrLn e) compat $ do
    tickcb <- widgetAddTickCallback w (tick st)
    return ()


unrealize :: State -> GLArea -> IO ()
unrealize _ _ = return ()

data Config = Config
    { cfgSchema   :: PipelineSchema
    , cfgPipeline :: Pipeline
    , cfgLogo     :: DynamicImage
    }

loadConfig :: IO (Either String Config)
loadConfig = do
    pipelineDesc <- do
            maybe (Left "Unable to parse hello.json") Right . JSON.decodeStrict <$> SB.readFile "hello.json"
        `catchIOError` \e -> return $ Left (show e)
    -- setup render data
    let inputSchema = makeSchema $ do
          defObjectArray "objects" Triangles $ do
            "position"  @: Attribute_V2F
            "uv"        @: Attribute_V2F
          defUniforms $ do
            "time"           @: Float
            "diffuseTexture" @: FTexture2D
    -- load image and upload texture
    img <- Juicy.readImage "logo.png"
        `catchIOError` \e -> return $ Left (show e)
    return $ Config inputSchema <$> pipelineDesc <*> img

-- 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
    }

createContext :: State -> GLArea -> IO GLContext
createContext st glarea = do
    Just win <- widgetGetWindow glarea
    gl <- windowCreateGlContext win
    return gl