Switched camera flight to use Animator utility.

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
 import GLWidget (nullableContext, withCurrentGL)
 import LambdaCube.GL.HMatrix
 import LambdaCubeWidget (loadPipeline,DynamicPipeline(..))
-import TimeKeeper
+import Animator
 import LoadMesh
 import InfinitePlane
 import MtlParser (ObjMaterial(..))
@@ -41,9 +41,8 @@ import Matrix
 
 -- State created by uploadState.
 data State = State
-    { stTimeKeeper   :: TimeKeeper
-    , stTickCallback :: TickCallbackHandle
-    , stCamera       :: IORef Camera
+    { stAnimator :: Animator
+    , stCamera   :: IORef Camera
     }
 
 data Camera = Camera
@@ -107,27 +106,28 @@ uploadState obj glarea storage = do
     uploadMeshToGPU xzplane >>= addMeshToObjectArray storage "plane" []
 
     -- setup FrameClock
-    tm <- newTimeKeeper
+    tm <- newAnimator =<< toWidget glarea
     cam <- newIORef initCamera
-    tickcb <- widgetAddTickCallback glarea (tick tm)
+    let st = State
+            { stAnimator     = tm
+            , stCamera       = cam
+            }
+    _ <- addAnimation tm (whirlingCamera st)
+
+    return st
 
-    return State
-        { stTimeKeeper   = tm
-        , stTickCallback = tickcb
-        , stCamera       = cam
-        }
 
 destroyState :: GLArea -> State -> IO ()
 destroyState glarea st = do
-    widgetRemoveTickCallback glarea (stTickCallback st)
+    -- widgetRemoveTickCallback glarea (stTickCallback st)
+    return ()
 
 deg30 :: Float
 deg30 = pi/6
 
-setUniforms :: glctx -> GLStorage -> State -> IO ()
-setUniforms gl storage st = do
-    t <- (/ 10.0) <$> getSeconds (stTimeKeeper st)
-    let tf = realToFrac t :: Float
+whirlingCamera :: State -> Animation
+whirlingCamera st = Animation $ \_ t -> do
+    let tf = realToFrac (t/10.0) :: Float
         rot = rotMatrixZ (-tf) <> rotMatrixX (-tf)
     modifyIORef (stCamera st) $ \cam -> cam
                             { camUp            = rot #> fromList [0,1,0]
@@ -135,7 +135,10 @@ setUniforms gl storage st = do
                             , camWorldToScreen = Nothing
                             , camScreenToWorld = Nothing
                             }
+    return $ Just (whirlingCamera st)
 
+setUniforms :: glctx -> GLStorage -> State -> IO ()
+setUniforms gl storage st = do
     (mvp,pos) <- atomicModifyIORef' (stCamera st) viewProjection
 
     {-