1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
module MeshMaker where
import Control.Monad
import Data.Coerce
import Data.IORef
import Foreign.C.Types
import GI.Gdk
import GI.GObject.Functions
import GI.Gtk
data MeshMaker = MeshMaker
{ mmWidget :: GLArea
, mmRealized :: IORef (Maybe State)
}
data State = State
{
}
new :: IO GLArea
new = do
w <- gLAreaNew
ref <- newIORef Nothing
let mm = MeshMaker w ref
-- _ <- on w #createContext $ onCreateContext mm
_ <- on w #realize $ onRealize mm
_ <- on w #unrealize $ onUnrealize mm
-- _ <- on w #destroy $ onDestroy mm
return w
onRealize :: MeshMaker -> IO ()
onRealize mm@(MeshMaker w ref) = do
putStrLn "realize!"
readIORef ref >>= \case
Just st -> onUnrealize mm -- Shouldn't happen.
Nothing -> return ()
widgetAddEvents w
[ EventMaskPointerMotionMask
, EventMaskButtonPressMask
, EventMaskButtonReleaseMask
, EventMaskTouchMask
, EventMaskScrollMask
]
_ <- on w #event $ onEvent mm
writeIORef ref $ Just State
{
}
onUnrealize :: MeshMaker -> IO ()
onUnrealize (MeshMaker w ref) = do
putStrLn "unrealize!"
readIORef ref >>= \case
Just st -> do
return ()
Nothing -> return () -- Shouldn't happen.
writeIORef ref Nothing
onRender :: MeshMaker -> GLContext -> IO Bool
onRender (MeshMaker w ref) gl = do
return True
onScroll :: MeshMaker -> EventScroll -> IO Bool
onScroll (MeshMaker w ref) ev = do
dx <- get ev #deltaX
dy <- get ev #deltaY
x <- get ev #x
y <- get ev #y
y_root <- get ev #yRoot
d <- get ev #direction
-- onScroll! ((0.0,0.0),(11.057525634765625,5.210357666015625),79.21035766601563)
putStrLn $ "onScroll! " ++ show (d,(dx,dy),(x,y),y_root)
return True
onTouch :: MeshMaker -> Event -> IO Bool
onTouch (MeshMaker w ref) ev = do
putStrLn $ "onTouch!"
return True
onMotion :: MeshMaker -> EventMotion -> IO Bool
onMotion (MeshMaker w ref) ev = do
putStrLn $ "onMotion!"
return True
onDestroy mm = do
putStrLn "destory!"
return ()
onEvent mm@(MeshMaker w ref) ev = do
msrc <- eventGetSourceDevice ev
inputSource <- forM msrc $ \src -> do
src <- get src #inputSource
return src
etype <- get ev #type
putStrLn $ "onEvent! " ++ show (etype,inputSource)
case etype of
EventTypeMotionNotify -> do
m <- get ev #motion
_ <- onMotion mm m
return ()
_ -> return ()
return False
|
