diff options
Diffstat (limited to 'MeshMaker.hs')
-rw-r--r-- | MeshMaker.hs | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/MeshMaker.hs b/MeshMaker.hs new file mode 100644 index 0000000..36ea2db --- /dev/null +++ b/MeshMaker.hs | |||
@@ -0,0 +1,73 @@ | |||
1 | {-# LANGUAGE LambdaCase #-} | ||
2 | {-# LANGUAGE OverloadedLabels #-} | ||
3 | module MeshMaker where | ||
4 | |||
5 | import Control.Monad | ||
6 | import Data.Coerce | ||
7 | import Data.IORef | ||
8 | import Foreign.C.Types | ||
9 | import GI.Gdk | ||
10 | import GI.GObject.Functions | ||
11 | import GI.Gtk | ||
12 | |||
13 | data MeshMaker = MeshMaker | ||
14 | { mmWidget :: GLArea | ||
15 | , mmRealized :: IORef (Maybe State) | ||
16 | } | ||
17 | |||
18 | data State = State | ||
19 | { | ||
20 | } | ||
21 | |||
22 | new :: IO GLArea | ||
23 | new = do | ||
24 | w <- gLAreaNew | ||
25 | ref <- newIORef Nothing | ||
26 | let st = MeshMaker w ref | ||
27 | -- _ <- on w #createContext $ onCreateContext st | ||
28 | _ <- on w #realize $ onRealize st | ||
29 | _ <- on w #unrealize $ onUnrealize st | ||
30 | return w | ||
31 | |||
32 | onRealize :: MeshMaker -> IO () | ||
33 | onRealize mm@(MeshMaker w ref) = do | ||
34 | readIORef ref >>= \case | ||
35 | Just st -> onUnrealize mm -- Shouldn't happen. | ||
36 | Nothing -> return () | ||
37 | writeIORef ref $ Just State | ||
38 | { | ||
39 | } | ||
40 | |||
41 | onUnrealize :: MeshMaker -> IO () | ||
42 | onUnrealize (MeshMaker w ref) = do | ||
43 | readIORef ref >>= \case | ||
44 | Just st -> do | ||
45 | return () | ||
46 | Nothing -> return () -- Shouldn't happen. | ||
47 | writeIORef ref Nothing | ||
48 | |||
49 | |||
50 | onRender :: MeshMaker -> GLContext -> IO Bool | ||
51 | onRender (MeshMaker w ref) gl = do | ||
52 | return True | ||
53 | |||
54 | onScroll :: MeshMaker -> EventScroll -> IO Bool | ||
55 | onScroll (MeshMaker w ref) ev = do | ||
56 | dx <- get ev #deltaX | ||
57 | dy <- get ev #deltaY | ||
58 | x <- get ev #x | ||
59 | y <- get ev #y | ||
60 | y_root <- get ev #yRoot | ||
61 | d <- get ev #direction | ||
62 | -- onScroll! ((0.0,0.0),(11.057525634765625,5.210357666015625),79.21035766601563) | ||
63 | putStrLn $ "onScroll! " ++ show (d,(dx,dy),(x,y),y_root) | ||
64 | return True | ||
65 | |||
66 | onTouch :: MeshMaker -> Event -> IO Bool | ||
67 | onTouch (MeshMaker w ref) ev = do | ||
68 | putStrLn $ "onTouch!" | ||
69 | return True | ||
70 | |||
71 | onMotion :: MeshMaker -> EventMotion -> IO Bool | ||
72 | onMotion (MeshMaker w ref) ev = do | ||
73 | return True | ||