summaryrefslogtreecommitdiff
path: root/MeshMaker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'MeshMaker.hs')
-rw-r--r--MeshMaker.hs71
1 files changed, 41 insertions, 30 deletions
diff --git a/MeshMaker.hs b/MeshMaker.hs
index d416023..6b7477a 100644
--- a/MeshMaker.hs
+++ b/MeshMaker.hs
@@ -9,14 +9,37 @@ import Foreign.C.Types
9import GI.Gdk 9import GI.Gdk
10import GI.GObject.Functions 10import GI.GObject.Functions
11import GI.Gtk 11import GI.Gtk
12import Numeric.LinearAlgebra
12 13
13data MeshMaker = MeshMaker 14data MeshMaker = MeshMaker
14 { mmWidget :: GLArea 15 { mmWidget :: GLArea
15 , mmRealized :: IORef (Maybe State) 16 , mmRealized :: IORef (Maybe State)
16 } 17 }
17 18
19data Camera = Camera
20 { camHeightAngle :: Float
21 , camTarget :: Vector Float
22 , camDirection :: Vector Float
23 , camDistance :: Float
24 , camWidth :: Float
25 , camHeight :: Float
26 , camWorldToScreen :: Maybe (Matrix Float)
27 , camScreenToWorld :: Maybe (Matrix Float)
28 }
29
18data State = State 30data State = State
19 { 31 { stCamera :: IORef Camera
32 }
33
34initCamera = Camera
35 { camHeightAngle = pi/6
36 , camTarget = fromList [0,0,0]
37 , camDirection = fromList [0,0,-1]
38 , camDistance = 10
39 , camWidth = 0
40 , camHeight = 0
41 , camWorldToScreen = Nothing
42 , camScreenToWorld = Nothing
20 } 43 }
21 44
22new :: IO GLArea 45new :: IO GLArea
@@ -44,8 +67,9 @@ onRealize mm@(MeshMaker w ref) = do
44 , EventMaskScrollMask 67 , EventMaskScrollMask
45 ] 68 ]
46 _ <- on w #event $ onEvent mm 69 _ <- on w #event $ onEvent mm
70 cam <- newIORef initCamera
47 writeIORef ref $ Just State 71 writeIORef ref $ Just State
48 { 72 { stCamera = cam
49 } 73 }
50 74
51onUnrealize :: MeshMaker -> IO () 75onUnrealize :: MeshMaker -> IO ()
@@ -62,31 +86,6 @@ onRender :: MeshMaker -> GLContext -> IO Bool
62onRender (MeshMaker w ref) gl = do 86onRender (MeshMaker w ref) gl = do
63 return True 87 return True
64 88
65onScroll :: MeshMaker -> EventScroll -> IO Bool
66onScroll (MeshMaker w ref) ev = do
67 dx <- get ev #deltaX
68 dy <- get ev #deltaY
69 x <- get ev #x
70 y <- get ev #y
71 y_root <- get ev #yRoot
72 d <- get ev #direction
73 -- onScroll! ((0.0,0.0),(11.057525634765625,5.210357666015625),79.21035766601563)
74 putStrLn $ "onScroll! " ++ show (d,(dx,dy),(x,y),y_root)
75 return True
76
77onTouch :: MeshMaker -> Event -> IO Bool
78onTouch (MeshMaker w ref) ev = do
79 putStrLn $ "onTouch!"
80 return True
81
82onMotion :: MeshMaker -> EventMotion -> IO Bool
83onMotion (MeshMaker w ref) ev = do
84 putStrLn $ "onMotion!"
85 return True
86
87onDestroy mm = do
88 putStrLn "destory!"
89 return ()
90 89
91onEvent mm@(MeshMaker w ref) ev = do 90onEvent mm@(MeshMaker w ref) ev = do
92 msrc <- eventGetSourceDevice ev 91 msrc <- eventGetSourceDevice ev
@@ -94,11 +93,23 @@ onEvent mm@(MeshMaker w ref) ev = do
94 src <- get src #inputSource 93 src <- get src #inputSource
95 return src 94 return src
96 etype <- get ev #type 95 etype <- get ev #type
97 putStrLn $ "onEvent! " ++ show (etype,inputSource) 96 -- putStrLn $ "onEvent! " ++ show (etype,inputSource)
97 let put x = putStrLn (show inputSource ++ " " ++ show x)
98 case etype of 98 case etype of
99
99 EventTypeMotionNotify -> do 100 EventTypeMotionNotify -> do
100 m <- get ev #motion 101 mev <- get ev #motion
101 _ <- onMotion mm m 102 x <- get mev #x
103 y <- get mev #y
104 put (x,y)
102 return () 105 return ()
106
107 EventTypeScroll -> do
108 sev <- get ev #scroll
109 d <- get sev #direction
110 put d
111 return ()
112
103 _ -> return () 113 _ -> return ()
114
104 return False 115 return False