From 4e754c89fdaed5f57dacaa5d67bfad7b498ceba3 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Mon, 29 Apr 2019 21:40:21 -0400 Subject: Switched camera flight to use Animator utility. --- MeshSketch.hs | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) (limited to 'MeshSketch.hs') 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 {- -- cgit v1.2.3