{-# LANGUAGE LambdaCase       #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE PatternSynonyms  #-}
module MeshSketch where

import Control.Monad
import Data.Coerce
import Data.IORef
import Foreign.C.Types
import GI.Gdk
import GI.GObject.Functions
import GI.Gtk hiding (IsWindow,windowFullscreen,windowUnfullscreen)
import Numeric.LinearAlgebra

import CubeMap

data MeshMaker = MeshMaker
    { mmWidget   :: GLArea
    , mmRealized :: IORef (Maybe State)
    }

data Camera = Camera
    { camHeightAngle   :: Float
    , camTarget        :: Vector Float
    , camDirection     :: Vector Float
    , camDistance      :: Float
    , camWidth         :: Float
    , camHeight        :: Float
    , camWorldToScreen :: Maybe (Matrix Float)
    , camScreenToWorld :: Maybe (Matrix Float)
    }

data State = State
    { stCamera     :: IORef Camera
    , stSkyboxes   :: Skyboxes
    , stSkybox     :: IORef Int
    , stFullscreen :: IO ()
    }

initCamera :: Camera
initCamera = Camera
    { camHeightAngle = pi/6
    , camTarget      = fromList [0,0,0]
    , camDirection   = fromList [0,0,-1]
    , camDistance    = 10
    , camWidth       = 0
    , camHeight      = 0
    , camWorldToScreen = Nothing
    , camScreenToWorld = Nothing
    }

new :: IO GLArea
new = do
    w <- gLAreaNew
    ref <- newIORef Nothing
    let mm = MeshMaker w ref
    -- _ <- on w #createContext $ onCreateContext mm
    _ <- on w #realize   $ onRealize mm
    _ <- on w #unrealize $ onUnrealize mm
    -- _ <- on w #destroy $ onDestroy mm
    return w

onRealize :: MeshMaker -> IO ()
onRealize mm@(MeshMaker w ref) = do
    putStrLn "realize!"
    readIORef ref >>= \case
        Just st -> onUnrealize mm -- Shouldn't happen.
        Nothing -> return ()
    set w [ #canFocus := True ] -- For keyboard events.
    widgetAddEvents w
        [ EventMaskPointerMotionMask
        , EventMaskButtonPressMask
        , EventMaskButtonReleaseMask
        , EventMaskTouchMask
        , EventMaskScrollMask
        , EventMaskKeyPressMask -- , EventMaskKeyReleaseMask
        ]
    cam <- newIORef initCamera
    skyboxes <- loadSkyboxes
    skybox <- newIORef 0
    Just pwidget <- get w #parent
    Just parent <- get pwidget #window
    toggle <- mkFullscreenToggle parent
    let st = State
            { stCamera     = cam
            , stSkyboxes   = skyboxes
            , stSkybox     = skybox
            , stFullscreen = toggle
            }

    _ <- on w #event $ onEvent w st
    writeIORef ref $ Just st

onUnrealize :: MeshMaker -> IO ()
onUnrealize (MeshMaker w ref) = do
    putStrLn "unrealize!"
    readIORef ref >>= \case
        Just st -> do
            return ()
        Nothing -> return () -- Shouldn't happen.
    writeIORef ref Nothing


onRender :: MeshMaker -> GLContext -> IO Bool
onRender (MeshMaker w ref) gl = do
    return True

onEvent :: w -> State -> Event -> IO Bool
onEvent w st ev = do
    msrc <- eventGetSourceDevice ev
    inputSource <- forM msrc $ \src -> do
        src <- get src #inputSource
        return src
    etype <- get ev #type
    -- putStrLn $ "onEvent! " ++ show (etype,inputSource)
    let put x = putStrLn (show inputSource ++ " " ++ show x)
    case etype of

        EventTypeMotionNotify -> do
            mev <- get ev #motion
            x <- get mev #x
            y <- get mev #y
            put (x,y)
            return ()

        EventTypeScroll -> do
            sev <- get ev #scroll
            d <- get sev #direction
            put d
            return ()

        EventTypeKeyPress -> do
            kev <- get ev #key
            val <- get kev #keyval
            if (val `elem` [KEY_N,KEY_n]) then do
                modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st)
                idx <- readIORef (stSkybox st)
                put (skyboxNames (stSkyboxes st) !! idx)
                return ()
            else when (val `elem` [KEY_F,KEY_f]) $ do
                put 'F'
                stFullscreen st
            return ()

        e -> return ()

    return False

mkFullscreenToggle :: IsWindow a => a -> IO (IO ())
mkFullscreenToggle w = do
    full <- newIORef False
    return $ do
        b <- atomicModifyIORef' full $ \b -> (not b, not b)
        if b then windowFullscreen w
             else windowUnfullscreen w