WIP: Skybox for MeshSketch rework.

1 files changed, 23 insertions, 2 deletions

diff --git a/MeshSketch.hs b/MeshSketch.hs
index 1408710..288488b 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -30,7 +30,9 @@ import Control.Exception
 import LambdaCube.GL as LC
 import LambdaCube.IR as LC
 import LambdaCube.Gtk
+import LambdaCube.GL.Data (uploadCubeMapToGPU)
 
+import CubeMap
 import GLWidget (nullableContext, withCurrentGL)
 import LambdaCube.GL.HMatrix
 import LambdaCubeWidget (loadPipeline,DynamicPipeline(..))
@@ -45,6 +47,9 @@ data State = State
     { stAnimator   :: Animator
     , stCamera     :: IORef Camera
     , stFullscreen :: IO ()
+    , stSkyboxes   :: Skyboxes
+    , stSkybox     :: IORef Int
+    , stSkyTexture :: IORef TextureData
     }
 
 data Camera = Camera
@@ -122,11 +127,23 @@ uploadState obj glarea storage = do
     Just pwidget <- get w #parent
     Just parent <- get pwidget #window
     toggle <- mkFullscreenToggle parent
+    skyboxes <- loadSkyboxes
+    skybox <- newIORef 0
+    Right ts <- skyboxLoad skyboxes 0
+    skybox_id <- uploadCubeMapToGPU ts
+    -- LC.updateUniforms storage $ do
+    --    "CubeMap" @= return skybox_id
+    skytex <- newIORef skybox_id
+    mi <- LC.uploadMeshToGPU cubeMesh
+    -- LC.addMeshToObjectArray storage "SkyCube" [] mi -- TODO
 
     let st = State
             { stAnimator     = tm
             , stCamera       = cam
             , stFullscreen   = toggle
+            , stSkyboxes     = skyboxes
+            , stSkybox       = skybox
+            , stSkyTexture   = skytex
             }
     _ <- addAnimation tm (whirlingCamera st)
 
@@ -291,13 +308,17 @@ onEvent w realized ev = do
             kev <- get ev #key
             val <- get kev #keyval <&> \k -> if k > 0x5A then k - 0x20 else k
             case val of
-                {-
                 KEY_N -> do
                     modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st)
                     idx <- readIORef (stSkybox st)
+                    Right ts <- skyboxLoad (stSkyboxes st) idx
+                    disposeTexture =<< readIORef (stSkyTexture st)
+                    skybox_id <- uploadCubeMapToGPU ts
+                    -- LC.updateUniforms storage $ do
+                    --    "CubeMap" @= return skybox_id
+                    writeIORef (stSkyTexture st) skybox_id
                     put (skyboxNames (stSkyboxes st) !! idx)
                     return ()
-                -}
                 KEY_F -> do
                     put 'F'
                     stFullscreen st