diff options
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 38 |
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 #-} | ||
3 | module MeshSketch where | 4 | module MeshSketch where |
4 | 5 | ||
5 | import Control.Monad | 6 | import Control.Monad |
@@ -11,6 +12,8 @@ import GI.GObject.Functions | |||
11 | import GI.Gtk | 12 | import GI.Gtk |
12 | import Numeric.LinearAlgebra | 13 | import Numeric.LinearAlgebra |
13 | 14 | ||
15 | import CubeMap | ||
16 | |||
14 | data MeshMaker = MeshMaker | 17 | data 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 | ||
30 | data State = State | 33 | data State = State |
31 | { stCamera :: IORef Camera | 34 | { stCamera :: IORef Camera |
35 | , stSkyboxes :: Skyboxes | ||
36 | , stSkybox :: IORef Int | ||
32 | } | 37 | } |
33 | 38 | ||
34 | initCamera = Camera | 39 | initCamera = 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 | ||
75 | onUnrealize :: MeshMaker -> IO () | 88 | onUnrealize :: MeshMaker -> IO () |
76 | onUnrealize (MeshMaker w ref) = do | 89 | onUnrealize (MeshMaker w ref) = do |
@@ -86,8 +99,7 @@ onRender :: MeshMaker -> GLContext -> IO Bool | |||
86 | onRender (MeshMaker w ref) gl = do | 99 | onRender (MeshMaker w ref) gl = do |
87 | return True | 100 | return True |
88 | 101 | ||
89 | 102 | onEvent w st ev = do | |
90 | onEvent 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 |