diff options
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 35 |
1 files changed, 19 insertions, 16 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs index 675c388..7d0392f 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs | |||
@@ -33,7 +33,7 @@ import LambdaCube.Gtk | |||
33 | import GLWidget (nullableContext, withCurrentGL) | 33 | import GLWidget (nullableContext, withCurrentGL) |
34 | import LambdaCube.GL.HMatrix | 34 | import LambdaCube.GL.HMatrix |
35 | import LambdaCubeWidget (loadPipeline,DynamicPipeline(..)) | 35 | import LambdaCubeWidget (loadPipeline,DynamicPipeline(..)) |
36 | import TimeKeeper | 36 | import Animator |
37 | import LoadMesh | 37 | import LoadMesh |
38 | import InfinitePlane | 38 | import InfinitePlane |
39 | import MtlParser (ObjMaterial(..)) | 39 | import MtlParser (ObjMaterial(..)) |
@@ -41,9 +41,8 @@ import Matrix | |||
41 | 41 | ||
42 | -- State created by uploadState. | 42 | -- State created by uploadState. |
43 | data State = State | 43 | data State = State |
44 | { stTimeKeeper :: TimeKeeper | 44 | { stAnimator :: Animator |
45 | , stTickCallback :: TickCallbackHandle | 45 | , stCamera :: IORef Camera |
46 | , stCamera :: IORef Camera | ||
47 | } | 46 | } |
48 | 47 | ||
49 | data Camera = Camera | 48 | data Camera = Camera |
@@ -107,27 +106,28 @@ uploadState obj glarea storage = do | |||
107 | uploadMeshToGPU xzplane >>= addMeshToObjectArray storage "plane" [] | 106 | uploadMeshToGPU xzplane >>= addMeshToObjectArray storage "plane" [] |
108 | 107 | ||
109 | -- setup FrameClock | 108 | -- setup FrameClock |
110 | tm <- newTimeKeeper | 109 | tm <- newAnimator =<< toWidget glarea |
111 | cam <- newIORef initCamera | 110 | cam <- newIORef initCamera |
112 | tickcb <- widgetAddTickCallback glarea (tick tm) | 111 | let st = State |
112 | { stAnimator = tm | ||
113 | , stCamera = cam | ||
114 | } | ||
115 | _ <- addAnimation tm (whirlingCamera st) | ||
116 | |||
117 | return st | ||
113 | 118 | ||
114 | return State | ||
115 | { stTimeKeeper = tm | ||
116 | , stTickCallback = tickcb | ||
117 | , stCamera = cam | ||
118 | } | ||
119 | 119 | ||
120 | destroyState :: GLArea -> State -> IO () | 120 | destroyState :: GLArea -> State -> IO () |
121 | destroyState glarea st = do | 121 | destroyState glarea st = do |
122 | widgetRemoveTickCallback glarea (stTickCallback st) | 122 | -- widgetRemoveTickCallback glarea (stTickCallback st) |
123 | return () | ||
123 | 124 | ||
124 | deg30 :: Float | 125 | deg30 :: Float |
125 | deg30 = pi/6 | 126 | deg30 = pi/6 |
126 | 127 | ||
127 | setUniforms :: glctx -> GLStorage -> State -> IO () | 128 | whirlingCamera :: State -> Animation |
128 | setUniforms gl storage st = do | 129 | whirlingCamera st = Animation $ \_ t -> do |
129 | t <- (/ 10.0) <$> getSeconds (stTimeKeeper st) | 130 | let tf = realToFrac (t/10.0) :: Float |
130 | let tf = realToFrac t :: Float | ||
131 | rot = rotMatrixZ (-tf) <> rotMatrixX (-tf) | 131 | rot = rotMatrixZ (-tf) <> rotMatrixX (-tf) |
132 | modifyIORef (stCamera st) $ \cam -> cam | 132 | modifyIORef (stCamera st) $ \cam -> cam |
133 | { camUp = rot #> fromList [0,1,0] | 133 | { camUp = rot #> fromList [0,1,0] |
@@ -135,7 +135,10 @@ setUniforms gl storage st = do | |||
135 | , camWorldToScreen = Nothing | 135 | , camWorldToScreen = Nothing |
136 | , camScreenToWorld = Nothing | 136 | , camScreenToWorld = Nothing |
137 | } | 137 | } |
138 | return $ Just (whirlingCamera st) | ||
138 | 139 | ||
140 | setUniforms :: glctx -> GLStorage -> State -> IO () | ||
141 | setUniforms gl storage st = do | ||
139 | (mvp,pos) <- atomicModifyIORef' (stCamera st) viewProjection | 142 | (mvp,pos) <- atomicModifyIORef' (stCamera st) viewProjection |
140 | 143 | ||
141 | {- | 144 | {- |