MeshSketch: fullscreen toggle.

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
 import Foreign.C.Types
 import GI.Gdk
 import GI.GObject.Functions
-import GI.Gtk
+import GI.Gtk hiding (IsWindow,windowFullscreen,windowUnfullscreen)
 import Numeric.LinearAlgebra
 
 import CubeMap
@@ -31,11 +31,13 @@ data Camera = Camera
     }
 
 data State = State
-    { stCamera   :: IORef Camera
-    , stSkyboxes :: Skyboxes
-    , stSkybox   :: IORef Int
+    { stCamera     :: IORef Camera
+    , stSkyboxes   :: Skyboxes
+    , stSkybox     :: IORef Int
+    , stFullscreen :: IO ()
     }
 
+initCamera :: Camera
 initCamera = Camera
     { camHeightAngle = pi/6
     , camTarget      = fromList [0,0,0]
@@ -76,10 +78,14 @@ onRealize mm@(MeshMaker w ref) = do
     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
+            { stCamera     = cam
+            , stSkyboxes   = skyboxes
+            , stSkybox     = skybox
+            , stFullscreen = toggle
             }
 
     _ <- on w #event $ onEvent w st
@@ -99,6 +105,7 @@ 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
@@ -125,13 +132,25 @@ onEvent w st ev = do
         EventTypeKeyPress -> do
             kev <- get ev #key
             val <- get kev #keyval
-            when (val `elem` [KEY_N,KEY_n]) $ do
+            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
+