Example showing how to do frame-based animation

Author: ivanperez-keera

assets/multimedia/animation/pftcc.png

@@ -0,0 +1,197 @@
+-- IDEAS: when a sheet is loaded, add the FPS for the animation
+-- and pass the delta time to the function that moves animations
+-- forward
+--
+-- Make managers monads, or better, monad transformers.
+--
+-- One will be IO-based, the other won't
+
+import           Control.Monad
+import           Data.IORef
+import           Data.List
+import qualified Data.Map              as M
+import           Data.Word
+import           Graphics.UI.SDL       as SDL
+import           Graphics.UI.SDL.Image as SDL
+
+main = do
+  SDL.init [InitVideo]
+  screen <- SDL.setVideoMode 480 320 32 [HWSurface, DoubleBuf]
+
+  spriteAnim <- loadTimedSpriteAnim "assets/multimedia/animation/pftcc.png" 80 14 coordsF
+
+  let assetMgr                    = mkAssetManager
+      visualMgr                   = mkVisualManager
+      (n', visualMgr', assetMgr') = registerAsset assetMgr visualMgr (TimeBasedAnim spriteAnim)
+
+  clock <- newSDLClock
+
+  lastTime <- readIORef clock
+
+  go assetMgr' visualMgr' n' clock lastTime
+
+go assetMgr visualMgr spriteAnim clock last = do
+
+    -- Constant FPS
+    -- SDL.delay 10
+    delayNextFrame 16 clock
+
+    -- Animations (pure)
+    ticks <- getTicks 
+    let dt = fromIntegral (ticks - last)
+    let visualMgr' = advanceAllAnim assetMgr visualMgr dt
+    print dt
+
+    -- Rendering
+    screen <- getVideoSurface
+
+    let format = SDL.surfaceGetPixelFormat screen
+    white <- SDL.mapRGB format 0xFF 0xFF 0xFF
+    SDL.fillRect screen Nothing white
+
+    showSpriteAnim assetMgr visualMgr' screen spriteAnim
+
+    SDL.flip screen
+
+    -- Loop
+    go assetMgr visualMgr' spriteAnim clock ticks
+
+type SpriteSheetFrameArea = Int -> Rect
+
+coordsF :: SpriteSheetFrameArea
+coordsF = spriteSheetCoords 5 73 68
+
+-- * Coordinates of sprite in left-to-right top-bottom equal-size sprite sheet
+spriteSheetCoords :: Int -> Int -> Int -> Int -> Rect
+spriteSheetCoords cols w h n = Rect x y w h
+ where x  = c * w
+       y  = r * h
+       c  = n `mod` cols
+       r  = n `div` cols
+
+-- * Visual manager and asset manager
+-- Visual manager is pure, asset manager is impure
+type VisualManagerInfo = M.Map VisualId VisualRepr
+
+type VisualId   = Int
+data VisualRepr = SpriteAnimationState (AssetId, Int)
+                | TimeSpriteAnimationState  (AssetId, Int, Int)
+
+mkVisualManager :: VisualManagerInfo
+mkVisualManager = M.empty
+
+visualManagerRegister :: VisualManagerInfo -> VisualRepr -> (VisualId, VisualManagerInfo)
+visualManagerRegister m r = (newReprId, m')
+ where m'        = M.insert newReprId r m
+       newReprId = nextFreeKey m 0
+
+-- * Asset manager
+mkAssetManager :: AssetManagerInfo
+mkAssetManager = M.empty
+
+type AssetManagerInfo = M.Map AssetId AssetRepr
+
+assetManagerRegister :: AssetManagerInfo -> AssetRepr -> (AssetId, AssetManagerInfo)
+assetManagerRegister m r = (newAssetId, m')
+ where m'         = M.insert newAssetId r m
+       newAssetId = nextFreeKey m 0
+
+nextFreeKey :: (Ord k, Enum k) => M.Map k v -> k -> k
+nextFreeKey m k = firstHole k sortedKeys 
+ where sortedKeys = sort (M.keys m)
+
+       -- | Find the first hole in a list
+       firstHole :: (Ord r, Enum r) => r -> [r] -> r
+       firstHole n [] = n
+       firstHole n (m:ms)
+          | n < m     = n
+          | otherwise = firstHole (succ n) ms
+
+type AssetId = Int
+data AssetRepr  = SpriteAnim SpriteAnim
+                | TimeBasedAnim TimeBasedAnim
+
+type SpriteAnim = ( SDL.Surface -- Sheet
+                  , Int         -- Num frames
+                  , [Rect]      -- Coordinates
+                  )
+
+type TimeBasedAnim = (SpriteAnim, Int) -- MS per frame
+
+-- IDEAS: add a displacement vector
+loadSpriteAnim :: FilePath -> Int -> (Int -> Rect) -> IO SpriteAnim
+loadSpriteAnim fp numFrames frameCoords = do
+  sheet <- load fp
+  let frames = map frameCoords [0..numFrames-1]
+  return (sheet, numFrames, frames)
+
+-- IDEAS: add a displacement vector
+loadTimedSpriteAnim :: FilePath -> Int -> Int -> (Int -> Rect) -> IO TimeBasedAnim
+loadTimedSpriteAnim fp ms numFrames frameCoords = do
+  sheet <- load fp
+  let frames = map frameCoords [0..numFrames-1]
+  return ((sheet, numFrames, frames), ms)
+
+advanceAllAnim :: AssetManagerInfo -> VisualManagerInfo -> Int -> VisualManagerInfo
+advanceAllAnim assetMgr visualMgr ms =
+  fmap (advanceSpriteAnim assetMgr ms) visualMgr
+
+advanceSpriteAnim :: AssetManagerInfo -> Int -> VisualRepr -> VisualRepr
+advanceSpriteAnim assetManagerInfo ms info@(TimeSpriteAnimationState (asset, n, lms)) =
+  case M.lookup asset assetManagerInfo of
+    (Just (TimeBasedAnim ((_, l, _),mms))) -> let numCycles = (lms + ms) `div` mms
+                                                  restMS    = (lms + ms) `mod` mms
+                                              in TimeSpriteAnimationState (asset,  (n+numCycles) `mod` l, restMS)
+    _                                     -> info
+  
+
+advanceSpriteAnim assetManagerInfo ms info@(SpriteAnimationState (asset, n)) =
+  case M.lookup asset assetManagerInfo of
+    (Just (SpriteAnim (_, l, _))) -> SpriteAnimationState (asset, (n+1) `mod` l)
+    _                             -> info
+
+-- ** Rendering
+showSpriteAnim :: AssetManagerInfo -> VisualManagerInfo -> Surface -> VisualId -> IO ()
+showSpriteAnim assetMgr visualMgr screen anim = do
+   case M.lookup anim visualMgr of
+     Nothing -> return ()
+     
+     Just (TimeSpriteAnimationState (a, f,oms)) -> case M.lookup a assetMgr of
+                      Just (TimeBasedAnim ((s, _, r),_)) -> do
+                        let rect = r!!f
+                        SDL.blitSurface s (Just rect) screen Nothing
+                        return ()
+                      _ -> return ()
+     Just (SpriteAnimationState (a, f)) -> case M.lookup a assetMgr of
+                      Just (SpriteAnim (s, _, r)) -> do
+                        let rect = r!!f
+                        SDL.blitSurface s (Just rect) screen Nothing
+                        return ()
+                      _ -> return ()
+
+registerAsset :: AssetManagerInfo -> VisualManagerInfo -> AssetRepr -> (VisualId, VisualManagerInfo, AssetManagerInfo)
+registerAsset assetMgr visualMgr asset@(TimeBasedAnim _) = (n', visualMgr', assetMgr')
+ where (n', visualMgr') = visualManagerRegister visualMgr (TimeSpriteAnimationState (n, 0, 0))
+       (n,  assetMgr')  = assetManagerRegister  assetMgr asset
+registerAsset assetMgr visualMgr asset@(SpriteAnim _) = (n', visualMgr', assetMgr')
+ where (n', visualMgr') = visualManagerRegister visualMgr (SpriteAnimationState (n, 0))
+       (n,  assetMgr')  = assetManagerRegister  assetMgr asset
+
+-- * Abstract SDL Clock
+type SDLClock = IORef Word32
+
+newSDLClock = do
+  n <- SDL.getTicks
+  newIORef n
+
+updateSDLClock clock = do
+  n <- SDL.getTicks
+  writeIORef clock n
+
+delayNextFrame :: Word32 -> SDLClock -> IO ()
+delayNextFrame ms clock = do
+  n <- SDL.getTicks
+  o <- readIORef clock
+  let diff = n - o
+  when (ms > diff) $ SDL.delay (ms - diff)
+  writeIORef clock n