{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Lambda2 where

import qualified Graphics.Rendering.OpenGL as GL

import GI.Gtk.Objects (GLArea,gLAreaGetContext,widgetGetWindow)
import GI.Gdk.Objects.GLContext (GLContext, gLContextGetDebugEnabled,
                                 gLContextGetForwardCompatible,
                                 gLContextSetDebugEnabled,
                                 gLContextSetForwardCompatible,
                                 gLContextGetRequiredVersion,
                                 gLContextSetRequiredVersion,
                                 gLContextGetUseEs,
                                 getGLContextWindow,
                                 gLContextMakeCurrent)
import GI.Gdk.Objects.Window (windowCreateGlContext,windowGetWidth,windowGetHeight)

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
import Data.Char
import Text.Printf
import System.IO

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

data State = State

initState :: IO State
initState = do
    return State

render :: State -> GLArea -> GLContext -> IO Bool
render st glarea gl = do
    cf <- GL.get GL.cullFace
    oldvp <- GL.get GL.viewport
    putStrLn $ "cullface = " ++ show cf
    putStrLn $ "viewport = " ++ show oldvp
    GL.cullFace GL.$= Nothing

    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  -> loop
        where loop = do
                -- update graphics input
                -- 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 (wd,ht)
                vp <- GL.get GL.viewport
                dr <- GL.get GL.depthRange
                mm <- GL.get GL.matrixMode
                mat <- GL.get (GL.matrix $ Just mm)
                cs <- GL.getMatrixComponents GL.RowMajor mat
                dc <- GL.get GL.depthClamp
                tms <- mapM (GL.get . GL.textureGenMode) [GL.S, GL.T, GL.R, GL.Q]
                mx <- GL.get GL.maxViewportDims
                print (vp,(wd,ht),dr,mm,dc)
                print (mat :: GL.GLmatrix Double, cs)
                print (tms,mx)
                return (wd,ht) >>= \(w,h) -> LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
                LambdaCubeGL.updateUniforms storage $ do
                  "diffuseTexture" @= return textureData
                  "time" @= do
                              Just t <- return $ Just (1.0::Double) -- GLFW.getTime
                              return (realToFrac t :: Float)
                -- render
                -- GL.clearColor GL.$= GL.Color4 0 0 0 0
                -- GL.clear [GL.ColorBuffer,GL.DepthBuffer]
                putStrLn "LambdaCubeGL.renderFrame enter.."
                -- mapM_ print $ glCommands renderer
                RF.renderFrame renderer
                putStrLn "LambdaCubeGL.renderFrame ..exit"
                -- GL.clear [GL.ColorBuffer,GL.DepthBuffer]
                -- GLFW.swapBuffers win
                -- GLFW.pollEvents
                -- GL.flush

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

    LambdaCubeGL.disposeRenderer renderer
    -- LambdaCubeGL.disposeStorage storage -- XXX: not implemented
    -- GLFW.destroyWindow win
    -- GLFW.terminate
    return True

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

realize :: State -> GLArea -> IO ()
realize st glarea = do
    putStrLn "realize!"
    {-
    GL.debugMessageInsert (GL.DebugMessage GL.DebugSourceApplication
                                           GL.DebugTypeOther
                                           (GL.DebugMessageID 0)
                                           GL.DebugSeverityHigh
                                           "Hello2 world!")
    -}
    return ()

unrealize :: State -> GLArea -> IO ()
unrealize st glarea = do
    return ()

prettyDebug :: GL.DebugMessage -> String
prettyDebug (GL.DebugMessage src typ (GL.DebugMessageID mid) severity msg) = unwords ws
 where
    ws = [wsrc,wtyp,wmid,wseverity,msg]
    -- DebugSourceShaderCompiler DebugTypeOther 1 DebugSeverityNotification
    wsrc = filter isUpper $ drop 11 $ show src
    wtyp = take 2 $ drop 9 $ show typ
    wmid = printf "%03i" mid
    wseverity = drop 13 $ show severity

createContext :: State -> GLArea -> IO GLContext
createContext st glarea = do
    putStrLn "createContext!"
    -- gl <- gLAreaGetContext glarea -- Remember to bind signal with 'after' so that this is not nullPtr.
    Just win <- widgetGetWindow glarea
    gl <- windowCreateGlContext win
    (maj,min) <- gLContextGetRequiredVersion gl
    -- (vmaj,vmin) <- gLContextGetVersion gl -- must be realized
    -- islegacy <- gLContextIsLegacy gl -- must be realized
    -- v_es <-gLContextGetUseEs gl

    v_db <- gLContextGetDebugEnabled gl
    v_fw <- gLContextGetForwardCompatible gl
    v_es <- gLContextGetUseEs gl
    putStrLn $ unwords [ "debug:",show v_db
                       , "fw:",show v_fw
                       , "es:", show v_es
                       , "ver:", show (maj,min)
                       ]
    gLContextSetDebugEnabled gl True
    gLContextSetForwardCompatible gl False -- True
    gLContextSetRequiredVersion gl 3 3
    v_db <- gLContextGetDebugEnabled gl
    v_fw <- gLContextGetForwardCompatible gl
    (maj,min) <- gLContextGetRequiredVersion gl
    putStrLn $ unwords [ "debug:",show v_db
                       , "fw:",show v_fw
                       , "ver:", show (maj,min)
                       ]
    let pdebug m@(GL.DebugMessage src typ mid severity msg) = do
            putStrLn (">> " ++ prettyDebug m)
    gLContextMakeCurrent gl
    GL.debugOutput GL.$= GL.Enabled
    GL.debugOutputSynchronous GL.$= GL.Enabled
    GL.debugMessageControl (GL.MessageGroup Nothing Nothing Nothing) GL.$= GL.Enabled
    GL.debugMessageCallback GL.$= Just pdebug
    {-
    GL.debugMessageInsert (GL.DebugMessage GL.DebugSourceApplication
                                           GL.DebugTypeOther
                                           (GL.DebugMessageID 0)
                                           GL.DebugSeverityHigh
                                           "Hello world!")
    -}
    return gl