blob: 36ea2db8a992b0bb9592f5165a197dfb107c0042 (
plain)
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
|
{-# 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 st = MeshMaker w ref
-- _ <- on w #createContext $ onCreateContext st
_ <- on w #realize $ onRealize st
_ <- on w #unrealize $ onUnrealize st
return w
onRealize :: MeshMaker -> IO ()
onRealize mm@(MeshMaker w ref) = do
readIORef ref >>= \case
Just st -> onUnrealize mm -- Shouldn't happen.
Nothing -> return ()
writeIORef ref $ Just State
{
}
onUnrealize :: MeshMaker -> IO ()
onUnrealize (MeshMaker w ref) = do
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
return True
|
