diff options
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 35 |
1 files changed, 27 insertions, 8 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs index 0040359..571cffe 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs | |||
@@ -9,7 +9,7 @@ import Data.IORef | |||
9 | import Foreign.C.Types | 9 | import Foreign.C.Types |
10 | import GI.Gdk | 10 | import GI.Gdk |
11 | import GI.GObject.Functions | 11 | import GI.GObject.Functions |
12 | import GI.Gtk | 12 | import GI.Gtk hiding (IsWindow,windowFullscreen,windowUnfullscreen) |
13 | import Numeric.LinearAlgebra | 13 | import Numeric.LinearAlgebra |
14 | 14 | ||
15 | import CubeMap | 15 | import CubeMap |
@@ -31,11 +31,13 @@ data Camera = Camera | |||
31 | } | 31 | } |
32 | 32 | ||
33 | data State = State | 33 | data State = State |
34 | { stCamera :: IORef Camera | 34 | { stCamera :: IORef Camera |
35 | , stSkyboxes :: Skyboxes | 35 | , stSkyboxes :: Skyboxes |
36 | , stSkybox :: IORef Int | 36 | , stSkybox :: IORef Int |
37 | , stFullscreen :: IO () | ||
37 | } | 38 | } |
38 | 39 | ||
40 | initCamera :: Camera | ||
39 | initCamera = Camera | 41 | initCamera = Camera |
40 | { camHeightAngle = pi/6 | 42 | { camHeightAngle = pi/6 |
41 | , camTarget = fromList [0,0,0] | 43 | , camTarget = fromList [0,0,0] |
@@ -76,10 +78,14 @@ onRealize mm@(MeshMaker w ref) = do | |||
76 | cam <- newIORef initCamera | 78 | cam <- newIORef initCamera |
77 | skyboxes <- loadSkyboxes | 79 | skyboxes <- loadSkyboxes |
78 | skybox <- newIORef 0 | 80 | skybox <- newIORef 0 |
81 | Just pwidget <- get w #parent | ||
82 | Just parent <- get pwidget #window | ||
83 | toggle <- mkFullscreenToggle parent | ||
79 | let st = State | 84 | let st = State |
80 | { stCamera = cam | 85 | { stCamera = cam |
81 | , stSkyboxes = skyboxes | 86 | , stSkyboxes = skyboxes |
82 | , stSkybox = skybox | 87 | , stSkybox = skybox |
88 | , stFullscreen = toggle | ||
83 | } | 89 | } |
84 | 90 | ||
85 | _ <- on w #event $ onEvent w st | 91 | _ <- on w #event $ onEvent w st |
@@ -99,6 +105,7 @@ onRender :: MeshMaker -> GLContext -> IO Bool | |||
99 | onRender (MeshMaker w ref) gl = do | 105 | onRender (MeshMaker w ref) gl = do |
100 | return True | 106 | return True |
101 | 107 | ||
108 | onEvent :: w -> State -> Event -> IO Bool | ||
102 | onEvent w st ev = do | 109 | onEvent w st ev = do |
103 | msrc <- eventGetSourceDevice ev | 110 | msrc <- eventGetSourceDevice ev |
104 | inputSource <- forM msrc $ \src -> do | 111 | inputSource <- forM msrc $ \src -> do |
@@ -125,13 +132,25 @@ onEvent w st ev = do | |||
125 | EventTypeKeyPress -> do | 132 | EventTypeKeyPress -> do |
126 | kev <- get ev #key | 133 | kev <- get ev #key |
127 | val <- get kev #keyval | 134 | val <- get kev #keyval |
128 | when (val `elem` [KEY_N,KEY_n]) $ do | 135 | if (val `elem` [KEY_N,KEY_n]) then do |
129 | modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st) | 136 | modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st) |
130 | idx <- readIORef (stSkybox st) | 137 | idx <- readIORef (stSkybox st) |
131 | put (skyboxNames (stSkyboxes st) !! idx) | 138 | put (skyboxNames (stSkyboxes st) !! idx) |
132 | return () | 139 | return () |
140 | else when (val `elem` [KEY_F,KEY_f]) $ do | ||
141 | put 'F' | ||
142 | stFullscreen st | ||
133 | return () | 143 | return () |
134 | 144 | ||
135 | e -> return () | 145 | e -> return () |
136 | 146 | ||
137 | return False | 147 | return False |
148 | |||
149 | mkFullscreenToggle :: IsWindow a => a -> IO (IO ()) | ||
150 | mkFullscreenToggle w = do | ||
151 | full <- newIORef False | ||
152 | return $ do | ||
153 | b <- atomicModifyIORef' full $ \b -> (not b, not b) | ||
154 | if b then windowFullscreen w | ||
155 | else windowUnfullscreen w | ||
156 | |||