From ec5dad0999ca2b56422f4e3442a5aeee5672cb87 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Fri, 26 Apr 2019 13:29:32 -0400
Subject: MeshSketch: skybox toggle.

---
 CubeMap.hs    | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 MeshSketch.hs | 38 ++++++++++++++++++++++++-------
 2 files changed, 102 insertions(+), 8 deletions(-)
 create mode 100644 CubeMap.hs

diff --git a/CubeMap.hs b/CubeMap.hs
new file mode 100644
index 0000000..337881f
--- /dev/null
+++ b/CubeMap.hs
@@ -0,0 +1,72 @@
+module CubeMap
+    ( loadSkyboxes
+    , Skyboxes(..)
+    ) where
+
+import LambdaCube.GL as LC
+import LambdaCube.GL.Mesh as LC
+import LambdaCube.GL.Data (uploadCubeMapToGPU)
+
+import Data.Maybe
+import Control.Monad
+import Data.List
+import System.Directory
+import System.FilePath
+import Codec.Archive.Zip
+import qualified Data.ByteString.Lazy as Lazy
+import Codec.Picture as Juicy
+
+image_names_xyz_dir :: [String]
+image_names_xyz_dir =
+    [ "xforward"
+    , "xreverse"
+    , "yforward"
+    , "yreverse"
+    , "zforward"
+    , "zreverse" ]
+
+image_names_np_xyz :: [String]
+image_names_np_xyz =
+    [ "negx"
+    , "negy"
+    , "negz"
+    , "posx"
+    , "posy"
+    , "posz" ]
+
+
+filterImageNames :: [String] -> [String]
+filterImageNames fns = map snd $ sortOn fst
+                        $ go (zip [0..] image_names_xyz_dir)
+                             (zip [1,3,5,0,2,4] image_names_np_xyz)
+                             $ sort fns
+ where
+    go ((n,x):xs) ys         (fn:fns) | x `isPrefixOf` fn = (n,fn) : go xs ys fns
+    go xs         ((n,y):ys) (fn:fns) | y `isPrefixOf` fn = (n,fn) : go xs ys fns
+    go xs         ys         ( _:fns)                     = go xs ys fns
+    go xs         ys         []                           = []
+
+
+data Skyboxes = Skyboxes
+    { skyboxCount :: Int
+    , skyboxNames :: [String]
+    , skyboxLoad  :: Int -> IO (Either String [DynamicImage])
+    }
+
+loadSkyboxes :: IO Skyboxes
+loadSkyboxes = do
+    let dir = "./skyboxes"
+    zips <- listDirectory dir
+    let len = length zips
+    return Skyboxes
+        { skyboxCount = len
+        , skyboxNames = zips
+        , skyboxLoad  = \n -> do
+                let fn = zips !! mod n len
+                archive <- toArchive <$> Lazy.readFile (dir </> fn)
+                let es = mapMaybe (`findEntryByPath` archive) $ filterImageNames (filesInArchive archive)
+                imgs <- forM es $ \entry -> do
+                    return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry
+                return $ sequence imgs
+        }
+
diff --git a/MeshSketch.hs b/MeshSketch.hs
index e23820c..0040359 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase       #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE PatternSynonyms  #-}
 module MeshSketch where
 
 import Control.Monad
@@ -11,6 +12,8 @@ import GI.GObject.Functions
 import GI.Gtk
 import Numeric.LinearAlgebra
 
+import CubeMap
+
 data MeshMaker = MeshMaker
     { mmWidget   :: GLArea
     , mmRealized :: IORef (Maybe State)
@@ -28,7 +31,9 @@ data Camera = Camera
     }
 
 data State = State
-    { stCamera :: IORef Camera
+    { stCamera   :: IORef Camera
+    , stSkyboxes :: Skyboxes
+    , stSkybox   :: IORef Int
     }
 
 initCamera = Camera
@@ -59,18 +64,26 @@ onRealize mm@(MeshMaker w ref) = do
     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
         ]
-    _ <- on w #event $ onEvent mm
     cam <- newIORef initCamera
-    writeIORef ref $ Just State
-        { stCamera = cam
-        }
+    skyboxes <- loadSkyboxes
+    skybox <- newIORef 0
+    let st = State
+            { stCamera   = cam
+            , stSkyboxes = skyboxes
+            , stSkybox   = skybox
+            }
+
+    _ <- on w #event $ onEvent w st
+    writeIORef ref $ Just st
 
 onUnrealize :: MeshMaker -> IO ()
 onUnrealize (MeshMaker w ref) = do
@@ -86,8 +99,7 @@ onRender :: MeshMaker -> GLContext -> IO Bool
 onRender (MeshMaker w ref) gl = do
     return True
 
-
-onEvent mm@(MeshMaker w ref) ev = do
+onEvent w st ev = do
     msrc <- eventGetSourceDevice ev
     inputSource <- forM msrc $ \src -> do
         src <- get src #inputSource
@@ -110,6 +122,16 @@ onEvent mm@(MeshMaker w ref) ev = do
             put d
             return ()
 
-        _ -> return ()
+        EventTypeKeyPress -> do
+            kev <- get ev #key
+            val <- get kev #keyval
+            when (val `elem` [KEY_N,KEY_n]) $ do
+                modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st)
+                idx <- readIORef (stSkybox st)
+                put (skyboxNames (stSkyboxes st) !! idx)
+                return ()
+            return ()
+
+        e -> return ()
 
     return False
-- 
cgit v1.2.3