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 +3/−3
- library/Animate.hs +257/−0
- library/Data/Animate.hs +0/−257
- package.yaml +1/−1
- test-suite/AnimateSpec.hs +74/−0
- test-suite/Data/AnimateSpec.hs +0/−74
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