packages feed

animate 0.2.0 → 0.3.0

raw patch · 6 files changed

+335/−335 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Data.Animate: Frame :: loc -> Seconds -> Frame loc
- Data.Animate: FrameStep'Counter :: Seconds -> FrameStep
- Data.Animate: FrameStep'Delta :: DeltaSeconds -> FrameStep
- Data.Animate: Loop'Always :: Loop
- Data.Animate: Loop'Count :: Int -> Loop
- Data.Animate: Position :: key -> FrameIndex -> Seconds -> Loop -> Position key
- Data.Animate: SpriteClip :: Int -> Int -> Int -> Int -> Maybe (Int, Int) -> SpriteClip
- Data.Animate: SpriteSheet :: Animations key SpriteClip -> img -> SpriteSheet key img
- Data.Animate: SpriteSheetInfo :: FilePath -> Maybe Color -> [SpriteClip] -> Map Text [(FrameIndex, Seconds)] -> SpriteSheetInfo
- Data.Animate: animations :: Key key => (key -> [Frame loc]) -> Animations key loc
- Data.Animate: class (Ord key, Bounded key, Enum key) => Key key
- Data.Animate: class Key key => KeyName key
- Data.Animate: currentFrame :: Key key => Animations key loc -> Position key -> Frame loc
- Data.Animate: currentLocation :: Key key => Animations key loc -> Position key -> loc
- Data.Animate: data Animations key loc
- Data.Animate: data Frame loc
- Data.Animate: data FrameStep
- Data.Animate: data Loop
- Data.Animate: data Position key
- Data.Animate: data SpriteClip
- Data.Animate: data SpriteSheet key img
- Data.Animate: data SpriteSheetInfo
- Data.Animate: framesByAnimation :: Key key => Animations key loc -> key -> Vector (Frame loc)
- Data.Animate: initPosition :: Key key => key -> Position key
- Data.Animate: initPositionLoops :: Key key => key -> Int -> Position key
- Data.Animate: initPositionWithLoop :: Key key => key -> Loop -> Position key
- Data.Animate: instance Data.Aeson.Types.FromJSON.FromJSON Data.Animate.SpriteClip
- Data.Animate: instance Data.Aeson.Types.FromJSON.FromJSON Data.Animate.SpriteSheetInfo
- Data.Animate: instance Data.Aeson.Types.ToJSON.ToJSON Data.Animate.SpriteClip
- Data.Animate: instance Data.Aeson.Types.ToJSON.ToJSON Data.Animate.SpriteSheetInfo
- Data.Animate: instance GHC.Classes.Eq Data.Animate.FrameStep
- Data.Animate: instance GHC.Classes.Eq Data.Animate.Loop
- Data.Animate: instance GHC.Classes.Eq Data.Animate.SpriteClip
- Data.Animate: instance GHC.Classes.Eq Data.Animate.SpriteSheetInfo
- Data.Animate: instance GHC.Classes.Eq key => GHC.Classes.Eq (Data.Animate.Position key)
- Data.Animate: instance GHC.Classes.Eq loc => GHC.Classes.Eq (Data.Animate.Animations key loc)
- Data.Animate: instance GHC.Classes.Eq loc => GHC.Classes.Eq (Data.Animate.Frame loc)
- Data.Animate: instance GHC.Show.Show Data.Animate.FrameStep
- Data.Animate: instance GHC.Show.Show Data.Animate.Loop
- Data.Animate: instance GHC.Show.Show Data.Animate.SpriteClip
- Data.Animate: instance GHC.Show.Show Data.Animate.SpriteSheetInfo
- Data.Animate: instance GHC.Show.Show key => GHC.Show.Show (Data.Animate.Position key)
- Data.Animate: instance GHC.Show.Show loc => GHC.Show.Show (Data.Animate.Animations key loc)
- Data.Animate: instance GHC.Show.Show loc => GHC.Show.Show (Data.Animate.Frame loc)
- Data.Animate: isAnimationComplete :: Key key => Animations key loc -> Position key -> Bool
- Data.Animate: keyName :: KeyName key => key -> Text
- Data.Animate: nextKey :: Key key => key -> key
- Data.Animate: positionHasLooped :: Position key -> Position a -> Bool
- Data.Animate: prevKey :: Key key => key -> key
- Data.Animate: readSpriteSheetInfoJSON :: FilePath -> IO SpriteSheetInfo
- Data.Animate: readSpriteSheetJSON :: KeyName key => (FilePath -> Maybe Color -> IO img) -> FilePath -> IO (SpriteSheet key img)
- Data.Animate: stepFrame :: Frame loc -> Position key -> DeltaSeconds -> FrameStep
- Data.Animate: stepPosition :: Key key => Animations key loc -> Position key -> DeltaSeconds -> Position key
- Data.Animate: type Color = (Word8, Word8, Word8)
- Data.Animate: type DeltaSeconds = Seconds
- Data.Animate: type FrameIndex = Int
- Data.Animate: type Seconds = Float
+ Animate: Frame :: loc -> Seconds -> Frame loc
+ Animate: FrameStep'Counter :: Seconds -> FrameStep
+ Animate: FrameStep'Delta :: DeltaSeconds -> FrameStep
+ Animate: Loop'Always :: Loop
+ Animate: Loop'Count :: Int -> Loop
+ Animate: Position :: key -> FrameIndex -> Seconds -> Loop -> Position key
+ Animate: SpriteClip :: Int -> Int -> Int -> Int -> Maybe (Int, Int) -> SpriteClip
+ Animate: SpriteSheet :: Animations key SpriteClip -> img -> SpriteSheet key img
+ Animate: SpriteSheetInfo :: FilePath -> Maybe Color -> [SpriteClip] -> Map Text [(FrameIndex, Seconds)] -> SpriteSheetInfo
+ Animate: animations :: Key key => (key -> [Frame loc]) -> Animations key loc
+ Animate: class (Ord key, Bounded key, Enum key) => Key key
+ Animate: class Key key => KeyName key
+ Animate: currentFrame :: Key key => Animations key loc -> Position key -> Frame loc
+ Animate: currentLocation :: Key key => Animations key loc -> Position key -> loc
+ Animate: data Animations key loc
+ Animate: data Frame loc
+ Animate: data FrameStep
+ Animate: data Loop
+ Animate: data Position key
+ Animate: data SpriteClip
+ Animate: data SpriteSheet key img
+ Animate: data SpriteSheetInfo
+ Animate: framesByAnimation :: Key key => Animations key loc -> key -> Vector (Frame loc)
+ Animate: initPosition :: Key key => key -> Position key
+ Animate: initPositionLoops :: Key key => key -> Int -> Position key
+ Animate: initPositionWithLoop :: Key key => key -> Loop -> Position key
+ Animate: instance Data.Aeson.Types.FromJSON.FromJSON Animate.SpriteClip
+ Animate: instance Data.Aeson.Types.FromJSON.FromJSON Animate.SpriteSheetInfo
+ Animate: instance Data.Aeson.Types.ToJSON.ToJSON Animate.SpriteClip
+ Animate: instance Data.Aeson.Types.ToJSON.ToJSON Animate.SpriteSheetInfo
+ Animate: instance GHC.Classes.Eq Animate.FrameStep
+ Animate: instance GHC.Classes.Eq Animate.Loop
+ Animate: instance GHC.Classes.Eq Animate.SpriteClip
+ Animate: instance GHC.Classes.Eq Animate.SpriteSheetInfo
+ Animate: instance GHC.Classes.Eq key => GHC.Classes.Eq (Animate.Position key)
+ Animate: instance GHC.Classes.Eq loc => GHC.Classes.Eq (Animate.Animations key loc)
+ Animate: instance GHC.Classes.Eq loc => GHC.Classes.Eq (Animate.Frame loc)
+ Animate: instance GHC.Show.Show Animate.FrameStep
+ Animate: instance GHC.Show.Show Animate.Loop
+ Animate: instance GHC.Show.Show Animate.SpriteClip
+ Animate: instance GHC.Show.Show Animate.SpriteSheetInfo
+ Animate: instance GHC.Show.Show key => GHC.Show.Show (Animate.Position key)
+ Animate: instance GHC.Show.Show loc => GHC.Show.Show (Animate.Animations key loc)
+ Animate: instance GHC.Show.Show loc => GHC.Show.Show (Animate.Frame loc)
+ Animate: isAnimationComplete :: Key key => Animations key loc -> Position key -> Bool
+ Animate: keyName :: KeyName key => key -> Text
+ Animate: nextKey :: Key key => key -> key
+ Animate: positionHasLooped :: Position key -> Position key -> Bool
+ Animate: prevKey :: Key key => key -> key
+ Animate: readSpriteSheetInfoJSON :: FilePath -> IO SpriteSheetInfo
+ Animate: readSpriteSheetJSON :: KeyName key => (FilePath -> Maybe Color -> IO img) -> FilePath -> IO (SpriteSheet key img)
+ Animate: stepFrame :: Frame loc -> Position key -> DeltaSeconds -> FrameStep
+ Animate: stepPosition :: Key key => Animations key loc -> Position key -> DeltaSeconds -> Position key
+ Animate: type Color = (Word8, Word8, Word8)
+ Animate: type DeltaSeconds = Seconds
+ Animate: type FrameIndex = Int
+ Animate: type Seconds = Float

Files

animate.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           animate-version:        0.2.0+version:        0.3.0 synopsis:       Animation for sprites description:    Prototypical sprite animation with type-safety. category:       Game@@ -37,7 +37,7 @@     , text     , vector   exposed-modules:-      Data.Animate+      Animate   default-language: Haskell2010  test-suite animate-test-suite@@ -55,5 +55,5 @@     , hspec     , vector   other-modules:-      Data.AnimateSpec+      AnimateSpec   default-language: Haskell2010
+ library/Animate.hs view
@@ -0,0 +1,257 @@+module Animate+  ( Seconds+  , DeltaSeconds+  , Color+  , FrameIndex+  , Frame(..)+  , Animations+  , Loop(..)+  , Position(..)+  , FrameStep(..)+  , Key+  , KeyName(..)+  , SpriteClip(..)+  , SpriteSheet(..)+  , SpriteSheetInfo(..)+  , animations+  , framesByAnimation+  , initPosition+  , initPositionLoops+  , initPositionWithLoop+  , stepFrame+  , stepPosition+  , isAnimationComplete+  , positionHasLooped+  , currentFrame+  , currentLocation+  , nextKey+  , prevKey+  , readSpriteSheetInfoJSON+  , readSpriteSheetJSON+  ) where++import qualified Data.Vector as V (Vector, (!), length, fromList)+import qualified Data.Map as Map+import qualified Data.ByteString.Lazy as BL+import Control.Applicative ((<|>))+import Control.Monad (mzero)+import Data.Aeson (FromJSON(..), ToJSON(..), (.:), eitherDecode, object, (.=), Value(..))+import Data.Map (Map)+import Data.Word (Word8)+import Data.Text (Text)++-- | Avoided newtype wrapper for convenience+type Seconds = Float++-- | Type aliased seconds+type DeltaSeconds = Seconds++-- | Alias for RGB (8bit, 8bit, 8bit)+type Color = (Word8, Word8, Word8)++type FrameIndex = Int++data Frame loc = Frame+  { fLocation :: loc -- ^ User defined reference to the location of a sprite. For example, a sprite sheet clip.+  , fDelay :: Seconds -- ^ Minimium amount of time for the frame to last.+  } deriving (Show, Eq)++-- | Type safe animation set. Use an sum type with an `Enum` and `Bounded` instance for the animation, 'a'.+newtype Animations key loc = Animations { unAnimations :: V.Vector (V.Vector (Frame loc)) }+  deriving (Show, Eq)++-- | Sematically for an animation key constraint+class (Ord key, Bounded key, Enum key) => Key key++-- | Animation Keyframe. `keyName` is used for JSON parsing.+class Key key => KeyName key where+  keyName :: key -> Text++-- | Describe the boxed area of the 2d sprite inside a sprite sheet+data SpriteClip = SpriteClip+  { scX :: Int+  , scY :: Int+  , scW :: Int+  , scH :: Int+  , scOffset :: Maybe (Int, Int)+  } deriving (Show, Eq)++instance ToJSON SpriteClip where+  toJSON SpriteClip{scX,scY,scW,scH,scOffset} = case scOffset of+    Nothing -> toJSON (scX, scY, scW, scH)+    Just (ofsX, ofsY) -> toJSON (scX, scY, scW, scH, ofsX, ofsY)++instance FromJSON SpriteClip where+  parseJSON v =+    (do+      (x,y,w,h) <- parseJSON v+      return SpriteClip { scX = x, scY = y, scW = w, scH = h, scOffset = Nothing })+    <|>+    (do+      (x,y,w,h,ofsX,ofsY) <- parseJSON v+      return SpriteClip { scX = x, scY = y, scW = w, scH = h, scOffset = Just (ofsX, ofsY) })++-- | Generalized sprite sheet data structure+data SpriteSheet key img = SpriteSheet+  { ssAnimations :: Animations key SpriteClip+  , ssImage :: img+  }++-- | One way to represent sprite sheet information.+-- | JSON loading is included.+data SpriteSheetInfo = SpriteSheetInfo+  { ssiImage :: FilePath+  , ssiAlpha :: Maybe Color+  , ssiClips :: [SpriteClip]+  , ssiAnimations :: Map Text [(FrameIndex, Seconds)]+  } deriving (Show, Eq)++instance ToJSON SpriteSheetInfo where+  toJSON SpriteSheetInfo{ssiImage,ssiAlpha,ssiClips,ssiAnimations} = object+    [ "image" .= ssiImage+    , "alpha" .= ssiAlpha+    , "clips" .= ssiClips+    , "animations" .= ssiAnimations+    ]++instance FromJSON SpriteSheetInfo where+  parseJSON (Object o) = do+    image <- o .: "image"+    alpha <- o .: "alpha"+    clips <- o .: "clips"+    anis <- o .: "animations"+    return SpriteSheetInfo { ssiImage = image, ssiAlpha = alpha, ssiClips = clips, ssiAnimations = anis }+  parseJSON _ = mzero++-- | Generate animations given each constructor+animations :: Key key => (key -> [Frame loc]) -> Animations key loc+animations getFrames = Animations $ V.fromList $ map (V.fromList . getFrames) [minBound..maxBound]++-- | Lookup the frames of an animation+framesByAnimation :: Key key => Animations key loc -> key -> V.Vector (Frame loc)+framesByAnimation (Animations as) k = as V.! fromEnum k++data Loop+  = Loop'Always -- ^ Never stop looping. Animation can never be completed.+  | Loop'Count Int -- ^ Count down loops to below zero. 0 = no loop. 1 = one loop. 2 = two loops. etc.+  deriving (Show, Eq)++-- | State for progression through an animation+-- | `example = Position minBound 0 0 Loop'Always`+data Position key = Position+  { pKey :: key -- ^ Index for the animation.+  , pFrameIndex :: FrameIndex -- ^ Index wihin the animation. WARNING: Modifying to below zero or equal-to-or-greater-than-the-frame-count will throw out of bounds errors.+  , pCounter :: Seconds -- ^ Accumulated seconds to end of the frame. Will continue to compound if animation is completed.+  , pLoop :: Loop -- ^ How to loop through an animation. Loop'Count is a count down.+  } deriving (Show, Eq)++-- | New `Position` with its animation key to loop forever+initPosition :: Key key => key -> Position key+initPosition key = initPositionWithLoop key Loop'Always++-- | New `Position` with its animation key with a limited loop+initPositionLoops :: Key key => key -> Int -> Position key+initPositionLoops key count = initPositionWithLoop key (Loop'Count count)++-- | New `Position`+initPositionWithLoop :: Key key => key -> Loop -> Position key+initPositionWithLoop key loop = Position+  { pKey = key+  , pFrameIndex = 0+  , pCounter = 0+  , pLoop = loop+  }++-- | You can ignore. An intermediate type for `stepPosition` to judge how to increment the current frame.+data FrameStep+  = FrameStep'Counter Seconds -- ^ New counter to compare against the frame's delay.+  | FrameStep'Delta DeltaSeconds -- ^ How much delta to carry over into the next frame.+  deriving (Show, Eq)++-- | Intermediate function for how a frame should be step through.+stepFrame :: Frame loc -> Position key -> DeltaSeconds -> FrameStep+stepFrame Frame{fDelay} Position{pCounter} delta =+  if pCounter + delta >= fDelay+    then FrameStep'Delta $ pCounter + delta - fDelay+    else FrameStep'Counter $ pCounter + delta++-- | Step through the animation resulting a new position.+stepPosition :: Key key => Animations key loc -> Position key -> DeltaSeconds -> Position key+stepPosition as p d =+  case frameStep of+    FrameStep'Counter counter -> p{pCounter = counter }+    FrameStep'Delta delta -> stepPosition as p' delta+  where+    frameStep = stepFrame f p d+    fs = unAnimations as V.! fromEnum (pKey p)+    f = fs V.! pFrameIndex p+    p'= case pLoop p of+      Loop'Always -> p{pFrameIndex = (pFrameIndex p + 1) `mod` V.length fs, pCounter = 0}+      Loop'Count n -> let+        index = (pFrameIndex p + 1) `mod` V.length fs+        n' = if index == 0 then n - 1 else n+        in p+          { pFrameIndex = if n' < 0 then pFrameIndex p else index+          , pCounter = 0+          , pLoop = Loop'Count n' }++-- | Use the position to find the current frame of the animation.+currentFrame :: Key key => Animations key loc -> Position key -> Frame loc+currentFrame anis Position{pKey,pFrameIndex} = (framesByAnimation anis pKey) V.! pFrameIndex++-- | Use the position to find the current location, lik a sprite sheet clip, of the animation.+currentLocation :: Key key => Animations key loc -> Position key -> loc+currentLocation anis p = fLocation (currentFrame anis p)++-- | The animation has finished all its frames. Useful for signalling into switching to another animation.+--   With a Loop'Always, the animation will never be completed.+isAnimationComplete :: Key key => Animations key loc -> Position key -> Bool+isAnimationComplete as p = case pLoop p of+  Loop'Always -> False+  Loop'Count n -> n < 0 && pFrameIndex p == lastIndex && pCounter p >= fDelay lastFrame+  where+    frames = framesByAnimation as (pKey p)+    lastIndex = V.length frames - 1+    lastFrame = frames V.! lastIndex++-- | Cycle through the next animation key+nextKey :: Key key => key -> key+nextKey key = if key == maxBound then minBound else succ key++-- | Cycle through the previous animation key+prevKey :: Key key => key -> key+prevKey key = if key == minBound then maxBound else pred key++-- | Simple function diff'ing the position for loop change+positionHasLooped+  :: Position key -- ^ Previous+  -> Position key -- ^ Next+  -> Bool+positionHasLooped Position{ pLoop = Loop'Count c } Position{ pLoop = Loop'Count c' } = c > c'+positionHasLooped Position{ pLoop = Loop'Always } _ = False+positionHasLooped _ Position{ pLoop = Loop'Always } = False++-- | Quick function for loading `SpriteSheetInfo`.+-- | Check the example.+readSpriteSheetInfoJSON+  :: FilePath -- ^ Path of the sprite sheet info JSON file+  -> IO SpriteSheetInfo+readSpriteSheetInfoJSON path = do+  metaBytes <- BL.readFile path+  case eitherDecode metaBytes of+    Left _err -> error $ "Cannot parse Sprite Sheet Info \"" ++ path ++ "\""+    Right ssi -> return ssi++-- | Quick function for loading `SpriteSheetInfo`, then using it to load its image for a `SpriteSheet`+-- | Check the example.+readSpriteSheetJSON+  :: KeyName key+  => (FilePath -> Maybe Color -> IO img) -- ^ Inject animage loading function+  -> FilePath -- ^ Path of the sprite sheet info JSON file+  -> IO (SpriteSheet key img)+readSpriteSheetJSON loadImage infoPath = do+  SpriteSheetInfo{ssiImage, ssiClips, ssiAnimations, ssiAlpha} <- readSpriteSheetInfoJSON infoPath+  i <- loadImage ssiImage ssiAlpha+  let frame key = (key, map (\a -> Frame (ssiClips !! fst a) (snd a)) (ssiAnimations Map.! keyName key))+  let animationMap = Map.fromList $ map frame [minBound..maxBound]+  return $ SpriteSheet (animations $ (Map.!) animationMap) i
− library/Data/Animate.hs
@@ -1,257 +0,0 @@-module Data.Animate-  ( Seconds-  , DeltaSeconds-  , Color-  , FrameIndex-  , Frame(..)-  , Animations-  , Loop(..)-  , Position(..)-  , FrameStep(..)-  , Key-  , KeyName(..)-  , SpriteClip(..)-  , SpriteSheet(..)-  , SpriteSheetInfo(..)-  , animations-  , framesByAnimation-  , initPosition-  , initPositionLoops-  , initPositionWithLoop-  , stepFrame-  , stepPosition-  , isAnimationComplete-  , positionHasLooped-  , currentFrame-  , currentLocation-  , nextKey-  , prevKey-  , readSpriteSheetInfoJSON-  , readSpriteSheetJSON-  ) where--import qualified Data.Vector as V (Vector, (!), length, fromList)-import qualified Data.Map as Map-import qualified Data.ByteString.Lazy as BL-import Control.Applicative ((<|>))-import Control.Monad (mzero)-import Data.Aeson (FromJSON(..), ToJSON(..), (.:), eitherDecode, object, (.=), Value(..))-import Data.Map (Map)-import Data.Word (Word8)-import Data.Text (Text)---- | Avoided newtype wrapper for convenience-type Seconds = Float---- | Type aliased seconds-type DeltaSeconds = Seconds---- | Alias for RGB (8bit, 8bit, 8bit)-type Color = (Word8, Word8, Word8)--type FrameIndex = Int--data Frame loc = Frame-  { fLocation :: loc -- ^ User defined reference to the location of a sprite. For example, a sprite sheet clip.-  , fDelay :: Seconds -- ^ Minimium amount of time for the frame to last.-  } deriving (Show, Eq)---- | Type safe animation set. Use an sum type with an `Enum` and `Bounded` instance for the animation, 'a'.-newtype Animations key loc = Animations { unAnimations :: V.Vector (V.Vector (Frame loc)) }-  deriving (Show, Eq)---- | Sematically for an animation key constraint-class (Ord key, Bounded key, Enum key) => Key key---- | Animation Keyframe. `keyName` is used for JSON parsing.-class Key key => KeyName key where-  keyName :: key -> Text---- | Describe the boxed area of the 2d sprite inside a sprite sheet-data SpriteClip = SpriteClip-  { scX :: Int-  , scY :: Int-  , scW :: Int-  , scH :: Int-  , scOffset :: Maybe (Int, Int)-  } deriving (Show, Eq)--instance ToJSON SpriteClip where-  toJSON SpriteClip{scX,scY,scW,scH,scOffset} = case scOffset of-    Nothing -> toJSON (scX, scY, scW, scH)-    Just (ofsX, ofsY) -> toJSON (scX, scY, scW, scH, ofsX, ofsY)--instance FromJSON SpriteClip where-  parseJSON v =-    (do-      (x,y,w,h) <- parseJSON v-      return SpriteClip { scX = x, scY = y, scW = w, scH = h, scOffset = Nothing })-    <|>-    (do-      (x,y,w,h,ofsX,ofsY) <- parseJSON v-      return SpriteClip { scX = x, scY = y, scW = w, scH = h, scOffset = Just (ofsX, ofsY) })---- | Generalized sprite sheet data structure-data SpriteSheet key img = SpriteSheet-  { ssAnimations :: Animations key SpriteClip-  , ssImage :: img-  }---- | One way to represent sprite sheet information.--- | JSON loading is included.-data SpriteSheetInfo = SpriteSheetInfo-  { ssiImage :: FilePath-  , ssiAlpha :: Maybe Color-  , ssiClips :: [SpriteClip]-  , ssiAnimations :: Map Text [(FrameIndex, Seconds)]-  } deriving (Show, Eq)--instance ToJSON SpriteSheetInfo where-  toJSON SpriteSheetInfo{ssiImage,ssiAlpha,ssiClips,ssiAnimations} = object-    [ "image" .= ssiImage-    , "alpha" .= ssiAlpha-    , "clips" .= ssiClips-    , "animations" .= ssiAnimations-    ]--instance FromJSON SpriteSheetInfo where-  parseJSON (Object o) = do-    image <- o .: "image"-    alpha <- o .: "alpha"-    clips <- o .: "clips"-    anis <- o .: "animations"-    return SpriteSheetInfo { ssiImage = image, ssiAlpha = alpha, ssiClips = clips, ssiAnimations = anis }-  parseJSON _ = mzero---- | Generate animations given each constructor-animations :: Key key => (key -> [Frame loc]) -> Animations key loc-animations getFrames = Animations $ V.fromList $ map (V.fromList . getFrames) [minBound..maxBound]---- | Lookup the frames of an animation-framesByAnimation :: Key key => Animations key loc -> key -> V.Vector (Frame loc)-framesByAnimation (Animations as) k = as V.! fromEnum k--data Loop-  = Loop'Always -- ^ Never stop looping. Animation can never be completed.-  | Loop'Count Int -- ^ Count down loops to below zero. 0 = no loop. 1 = one loop. 2 = two loops. etc.-  deriving (Show, Eq)---- | State for progression through an animation--- | `example = Position minBound 0 0 Loop'Always`-data Position key = Position-  { pKey :: key -- ^ Index for the animation.-  , pFrameIndex :: FrameIndex -- ^ Index wihin the animation. WARNING: Modifying to below zero or equal-to-or-greater-than-the-frame-count will throw out of bounds errors.-  , pCounter :: Seconds -- ^ Accumulated seconds to end of the frame. Will continue to compound if animation is completed.-  , pLoop :: Loop -- ^ How to loop through an animation. Loop'Count is a count down.-  } deriving (Show, Eq)---- | New `Position` with its animation key to loop forever-initPosition :: Key key => key -> Position key-initPosition key = initPositionWithLoop key Loop'Always---- | New `Position` with its animation key with a limited loop-initPositionLoops :: Key key => key -> Int -> Position key-initPositionLoops key count = initPositionWithLoop key (Loop'Count count)---- | New `Position`-initPositionWithLoop :: Key key => key -> Loop -> Position key-initPositionWithLoop key loop = Position-  { pKey = key-  , pFrameIndex = 0-  , pCounter = 0-  , pLoop = loop-  }---- | You can ignore. An intermediate type for `stepPosition` to judge how to increment the current frame.-data FrameStep-  = FrameStep'Counter Seconds -- ^ New counter to compare against the frame's delay.-  | FrameStep'Delta DeltaSeconds -- ^ How much delta to carry over into the next frame.-  deriving (Show, Eq)---- | Intermediate function for how a frame should be step through.-stepFrame :: Frame loc -> Position key -> DeltaSeconds -> FrameStep-stepFrame Frame{fDelay} Position{pCounter} delta =-  if pCounter + delta >= fDelay-    then FrameStep'Delta $ pCounter + delta - fDelay-    else FrameStep'Counter $ pCounter + delta---- | Step through the animation resulting a new position.-stepPosition :: Key key => Animations key loc -> Position key -> DeltaSeconds -> Position key-stepPosition as p d =-  case frameStep of-    FrameStep'Counter counter -> p{pCounter = counter }-    FrameStep'Delta delta -> stepPosition as p' delta-  where-    frameStep = stepFrame f p d-    fs = unAnimations as V.! fromEnum (pKey p)-    f = fs V.! pFrameIndex p-    p'= case pLoop p of-      Loop'Always -> p{pFrameIndex = (pFrameIndex p + 1) `mod` V.length fs, pCounter = 0}-      Loop'Count n -> let-        index = (pFrameIndex p + 1) `mod` V.length fs-        n' = if index == 0 then n - 1 else n-        in p-          { pFrameIndex = if n' < 0 then pFrameIndex p else index-          , pCounter = 0-          , pLoop = Loop'Count n' }---- | Use the position to find the current frame of the animation.-currentFrame :: Key key => Animations key loc -> Position key -> Frame loc-currentFrame anis Position{pKey,pFrameIndex} = (framesByAnimation anis pKey) V.! pFrameIndex---- | Use the position to find the current location, lik a sprite sheet clip, of the animation.-currentLocation :: Key key => Animations key loc -> Position key -> loc-currentLocation anis p = fLocation (currentFrame anis p)---- | The animation has finished all its frames. Useful for signalling into switching to another animation.---   With a Loop'Always, the animation will never be completed.-isAnimationComplete :: Key key => Animations key loc -> Position key -> Bool-isAnimationComplete as p = case pLoop p of-  Loop'Always -> False-  Loop'Count n -> n < 0 && pFrameIndex p == lastIndex && pCounter p >= fDelay lastFrame-  where-    frames = framesByAnimation as (pKey p)-    lastIndex = V.length frames - 1-    lastFrame = frames V.! lastIndex---- | Cycle through the next animation key-nextKey :: Key key => key -> key-nextKey key = if key == maxBound then minBound else succ key---- | Cycle through the previous animation key-prevKey :: Key key => key -> key-prevKey key = if key == minBound then maxBound else pred key---- | Simple function diff'ing the position for loop change-positionHasLooped-  :: Position key -- ^ Previous-  -> Position a -- ^ Next-  -> Bool-positionHasLooped Position{ pLoop = Loop'Count c } Position{ pLoop = Loop'Count c' } = c > c'-positionHasLooped Position{ pLoop = Loop'Always } _ = False-positionHasLooped _ Position{ pLoop = Loop'Always } = False---- | Quick function for loading `SpriteSheetInfo`.--- | Check the example.-readSpriteSheetInfoJSON-  :: FilePath -- ^ Path of the sprite sheet info JSON file-  -> IO SpriteSheetInfo-readSpriteSheetInfoJSON path = do-  metaBytes <- BL.readFile path-  case eitherDecode metaBytes of-    Left _err -> error $ "Cannot parse Sprite Sheet Info \"" ++ path ++ "\""-    Right ssi -> return ssi---- | Quick function for loading `SpriteSheetInfo`, then using it to load its image for a `SpriteSheet`--- | Check the example.-readSpriteSheetJSON-  :: KeyName key-  => (FilePath -> Maybe Color -> IO img) -- ^ Inject animage loading function-  -> FilePath -- ^ Path of the sprite sheet info JSON file-  -> IO (SpriteSheet key img)-readSpriteSheetJSON loadImage infoPath = do-  SpriteSheetInfo{ssiImage, ssiClips, ssiAnimations, ssiAlpha} <- readSpriteSheetInfoJSON infoPath-  i <- loadImage ssiImage ssiAlpha-  let frame key = (key, map (\a -> Frame (ssiClips !! fst a) (snd a)) (ssiAnimations Map.! keyName key))-  let animationMap = Map.fromList $ map frame [minBound..maxBound]-  return $ SpriteSheet (animations $ (Map.!) animationMap) i
package.yaml view
@@ -1,5 +1,5 @@ name: animate-version: '0.2.0'+version: '0.3.0' category: Game synopsis: Animation for sprites description: Prototypical sprite animation with type-safety.
+ test-suite/AnimateSpec.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE LambdaCase #-}+module AnimateSpec where++import qualified Data.Vector as V+import Test.Hspec+import Animate++data Ani = Ani'Stand | Ani'Walk+  deriving (Show, Eq, Enum, Ord, Bounded)++instance Key Ani++spec :: Spec+spec = do+  describe "mkAnimations" $ do+    let getFrames Ani'Stand = [Frame 'a' 0.2, Frame 'b' 0.2]+        getFrames Ani'Walk = [Frame 'c' 0.2, Frame 'd' 0.2]+    let as = animations getFrames+    it "should have the correct frames for the given keyframe" $ do+      framesByAnimation as Ani'Stand `shouldBe` V.fromList [Frame 'a' 0.2, Frame 'b' 0.2]+      framesByAnimation as Ani'Walk `shouldBe` V.fromList [Frame 'c' 0.2, Frame 'd' 0.2]++  describe "stepFrame" $ do+    it "should have left over delta seconds and set the frame completion flag" $ do+      let delta = 0.9+      let actual = stepFrame Frame { fLocation = 'a', fDelay = 1.0 } Position { pKey = (0 :: Int), pFrameIndex = 0, pCounter = 0.3, pLoop = Loop'Always } delta+      let expected = 0.2+      actual `shouldSatisfy` (\(FrameStep'Delta actual') -> 1e6 > abs (actual' - expected))++  describe "stepPosition" $ do+    let getFrames Ani'Stand = [Frame 'a' 0.2, Frame 'b' 0.2]+        getFrames Ani'Walk = [Frame 'c' 0.2, Frame 'd' 0.2]+    let as = animations getFrames+    let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Always }+    it "should do nothing if given 0 delta seconds" $ do+      stepPosition as p 0 `shouldBe` p+    it "should go to the next frame" $ do+      stepPosition as p 0.2 `shouldBe` p { pFrameIndex = 1, pCounter = 0 }+    it "should loop to the start" $ do+      stepPosition as p 0.4 `shouldBe` p { pFrameIndex = 0, pCounter = 0 }+    it "should loop once" $ do+      stepPosition as p{ pLoop = Loop'Count 1 } 0.4 `shouldBe` p { pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }+    it "should not loop" $ do+      stepPosition as p{ pLoop = Loop'Count 0 } 0.4 `shouldBe` p { pFrameIndex = 1, pCounter = 0, pLoop = Loop'Count (-1) }++  describe "isAnimationComplete" $ do+    let getFrames Ani'Stand = [Frame 'a' 0.2, Frame 'b' 0.2]+        getFrames Ani'Walk = [Frame 'c' 0.2, Frame 'd' 0.2]+    let as = animations getFrames+    it "should be incomplete: loop is forever" $ do+      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Always }+      isAnimationComplete as p `shouldBe` False+    it "should be incomplete: frame isn't at the end and loop count is negative" $ do+      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count (-1) }+      isAnimationComplete as p `shouldBe` False+    it "should be complete: frame is at the end and loop count is negative and counter gte than delay" $ do+      let p = Position { pKey = Ani'Stand, pFrameIndex = 1, pCounter = 0.2, pLoop = Loop'Count (-1) }+      isAnimationComplete as p `shouldBe` True+    it "should be incomplete: frame is at the end and loop count is non-negative" $ do+      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }+      isAnimationComplete as p `shouldBe` False+    it "should be incomplete: frame isn't at the end and loop count is non-negative" $ do+      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count (-1) }+      isAnimationComplete as p `shouldBe` False++  describe "positionHasLooped" $ do+    it "should have looped" $ do+      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }+      let p' = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count (-1) }+      positionHasLooped p p' `shouldBe` True+    it "should not have looped" $ do+      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }+      let p' = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }+      positionHasLooped p p' `shouldBe` False
− test-suite/Data/AnimateSpec.hs
@@ -1,74 +0,0 @@-{-# LANGUAGE LambdaCase #-}-module Data.AnimateSpec where--import qualified Data.Vector as V-import Test.Hspec-import Data.Animate--data Ani = Ani'Stand | Ani'Walk-  deriving (Show, Eq, Enum, Ord, Bounded)--instance Key Ani--spec :: Spec-spec = do-  describe "mkAnimations" $ do-    let getFrames Ani'Stand = [Frame 'a' 0.2, Frame 'b' 0.2]-        getFrames Ani'Walk = [Frame 'c' 0.2, Frame 'd' 0.2]-    let as = animations getFrames-    it "should have the correct frames for the given keyframe" $ do-      framesByAnimation as Ani'Stand `shouldBe` V.fromList [Frame 'a' 0.2, Frame 'b' 0.2]-      framesByAnimation as Ani'Walk `shouldBe` V.fromList [Frame 'c' 0.2, Frame 'd' 0.2]--  describe "stepFrame" $ do-    it "should have left over delta seconds and set the frame completion flag" $ do-      let delta = 0.9-      let actual = stepFrame Frame { fLocation = 'a', fDelay = 1.0 } Position { pKey = (0 :: Int), pFrameIndex = 0, pCounter = 0.3, pLoop = Loop'Always } delta-      let expected = 0.2-      actual `shouldSatisfy` (\(FrameStep'Delta actual') -> 1e6 > abs (actual' - expected))--  describe "stepPosition" $ do-    let getFrames Ani'Stand = [Frame 'a' 0.2, Frame 'b' 0.2]-        getFrames Ani'Walk = [Frame 'c' 0.2, Frame 'd' 0.2]-    let as = animations getFrames-    let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Always }-    it "should do nothing if given 0 delta seconds" $ do-      stepPosition as p 0 `shouldBe` p-    it "should go to the next frame" $ do-      stepPosition as p 0.2 `shouldBe` p { pFrameIndex = 1, pCounter = 0 }-    it "should loop to the start" $ do-      stepPosition as p 0.4 `shouldBe` p { pFrameIndex = 0, pCounter = 0 }-    it "should loop once" $ do-      stepPosition as p{ pLoop = Loop'Count 1 } 0.4 `shouldBe` p { pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }-    it "should not loop" $ do-      stepPosition as p{ pLoop = Loop'Count 0 } 0.4 `shouldBe` p { pFrameIndex = 1, pCounter = 0, pLoop = Loop'Count (-1) }--  describe "isAnimationComplete" $ do-    let getFrames Ani'Stand = [Frame 'a' 0.2, Frame 'b' 0.2]-        getFrames Ani'Walk = [Frame 'c' 0.2, Frame 'd' 0.2]-    let as = animations getFrames-    it "should be incomplete: loop is forever" $ do-      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Always }-      isAnimationComplete as p `shouldBe` False-    it "should be incomplete: frame isn't at the end and loop count is negative" $ do-      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count (-1) }-      isAnimationComplete as p `shouldBe` False-    it "should be complete: frame is at the end and loop count is negative and counter gte than delay" $ do-      let p = Position { pKey = Ani'Stand, pFrameIndex = 1, pCounter = 0.2, pLoop = Loop'Count (-1) }-      isAnimationComplete as p `shouldBe` True-    it "should be incomplete: frame is at the end and loop count is non-negative" $ do-      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }-      isAnimationComplete as p `shouldBe` False-    it "should be incomplete: frame isn't at the end and loop count is non-negative" $ do-      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count (-1) }-      isAnimationComplete as p `shouldBe` False--  describe "positionHasLooped" $ do-    it "should have looped" $ do-      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }-      let p' = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count (-1) }-      positionHasLooped p p' `shouldBe` True-    it "should not have looped" $ do-      let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }-      let p' = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }-      positionHasLooped p p' `shouldBe` False