summaryrefslogtreecommitdiff
path: root/MeshSketch.hs
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-04-26 13:29:32 -0400
committerJoe Crayne <joe@jerkface.net>2019-04-26 13:29:32 -0400
commitec5dad0999ca2b56422f4e3442a5aeee5672cb87 (patch)
treedbebbab77ccd98e9bd03d69fc44c345f14706820 /MeshSketch.hs
parent98d08f9b94840c442d3352be6f1cd3f4c76c33c6 (diff)
MeshSketch: skybox toggle.
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r--MeshSketch.hs38
1 files changed, 30 insertions, 8 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs
index e23820c..0040359 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -1,5 +1,6 @@
1{-# LANGUAGE LambdaCase #-} 1{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE OverloadedLabels #-} 2{-# LANGUAGE OverloadedLabels #-}
3{-# LANGUAGE PatternSynonyms #-}
3module MeshSketch where 4module MeshSketch where
4 5
5import Control.Monad 6import Control.Monad
@@ -11,6 +12,8 @@ import GI.GObject.Functions
11import GI.Gtk 12import GI.Gtk
12import Numeric.LinearAlgebra 13import Numeric.LinearAlgebra
13 14
15import CubeMap
16
14data MeshMaker = MeshMaker 17data MeshMaker = MeshMaker
15 { mmWidget :: GLArea 18 { mmWidget :: GLArea
16 , mmRealized :: IORef (Maybe State) 19 , mmRealized :: IORef (Maybe State)
@@ -28,7 +31,9 @@ data Camera = Camera
28 } 31 }
29 32
30data State = State 33data State = State
31 { stCamera :: IORef Camera 34 { stCamera :: IORef Camera
35 , stSkyboxes :: Skyboxes
36 , stSkybox :: IORef Int
32 } 37 }
33 38
34initCamera = Camera 39initCamera = Camera
@@ -59,18 +64,26 @@ onRealize mm@(MeshMaker w ref) = do
59 readIORef ref >>= \case 64 readIORef ref >>= \case
60 Just st -> onUnrealize mm -- Shouldn't happen. 65 Just st -> onUnrealize mm -- Shouldn't happen.
61 Nothing -> return () 66 Nothing -> return ()
67 set w [ #canFocus := True ] -- For keyboard events.
62 widgetAddEvents w 68 widgetAddEvents w
63 [ EventMaskPointerMotionMask 69 [ EventMaskPointerMotionMask
64 , EventMaskButtonPressMask 70 , EventMaskButtonPressMask
65 , EventMaskButtonReleaseMask 71 , EventMaskButtonReleaseMask
66 , EventMaskTouchMask 72 , EventMaskTouchMask
67 , EventMaskScrollMask 73 , EventMaskScrollMask
74 , EventMaskKeyPressMask -- , EventMaskKeyReleaseMask
68 ] 75 ]
69 _ <- on w #event $ onEvent mm
70 cam <- newIORef initCamera 76 cam <- newIORef initCamera
71 writeIORef ref $ Just State 77 skyboxes <- loadSkyboxes
72 { stCamera = cam 78 skybox <- newIORef 0
73 } 79 let st = State
80 { stCamera = cam
81 , stSkyboxes = skyboxes
82 , stSkybox = skybox
83 }
84
85 _ <- on w #event $ onEvent w st
86 writeIORef ref $ Just st
74 87
75onUnrealize :: MeshMaker -> IO () 88onUnrealize :: MeshMaker -> IO ()
76onUnrealize (MeshMaker w ref) = do 89onUnrealize (MeshMaker w ref) = do
@@ -86,8 +99,7 @@ onRender :: MeshMaker -> GLContext -> IO Bool
86onRender (MeshMaker w ref) gl = do 99onRender (MeshMaker w ref) gl = do
87 return True 100 return True
88 101
89 102onEvent w st ev = do
90onEvent mm@(MeshMaker w ref) ev = do
91 msrc <- eventGetSourceDevice ev 103 msrc <- eventGetSourceDevice ev
92 inputSource <- forM msrc $ \src -> do 104 inputSource <- forM msrc $ \src -> do
93 src <- get src #inputSource 105 src <- get src #inputSource
@@ -110,6 +122,16 @@ onEvent mm@(MeshMaker w ref) ev = do
110 put d 122 put d
111 return () 123 return ()
112 124
113 _ -> return () 125 EventTypeKeyPress -> do
126 kev <- get ev #key
127 val <- get kev #keyval
128 when (val `elem` [KEY_N,KEY_n]) $ do
129 modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st)
130 idx <- readIORef (stSkybox st)
131 put (skyboxNames (stSkyboxes st) !! idx)
132 return ()
133 return ()
134
135 e -> return ()
114 136
115 return False 137 return False