animate 0.1.0 → 0.2.0

raw patch · 4 files changed

+249/−80 lines, 4 filesdep +aesondep +bytestringdep +containersPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, bytestring, containers, text

API changes (from Hackage documentation)

Files

• animate.cabal +9/−3
• library/Data/Animate.hs +197/−47
• package.yaml +8/−1
• test-suite/Data/AnimateSpec.hs +35/−29

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           animate-version:        0.1.0+version:        0.2.0 synopsis:       Animation for sprites description:    Prototypical sprite animation with type-safety. category:       Game@@ -27,10 +27,14 @@ library   hs-source-dirs:       library-  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables+  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables OverloadedStrings   ghc-options: -Wall   build-depends:       base >=4.7 && <5+    , aeson+    , bytestring+    , containers+    , text     , vector   exposed-modules:       Data.Animate@@ -41,11 +45,13 @@   main-is: Main.hs   hs-source-dirs:       test-suite-  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables+  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables OverloadedStrings   ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N   build-depends:       base+    , aeson     , animate+    , containers     , hspec     , vector   other-modules:

@@ -1,107 +1,257 @@ module Data.Animate   ( Seconds   , DeltaSeconds+  , Color+  , FrameIndex   , Frame(..)   , Animations-  , animations-  , framesByAnimation   , Loop(..)   , Position(..)   , FrameStep(..)+  , Key+  , KeyName(..)+  , SpriteClip(..)+  , SpriteSheet(..)+  , SpriteSheetInfo(..)+  , animations+  , framesByAnimation+  , initPosition+  , initPositionLoops+  , initPositionWithLoop   , stepFrame-  , stepAnimation+  , 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 (tentative)+-- | Avoided newtype wrapper for convenience type Seconds = Float --- | Type aliased seconds (tentative)+-- | Type aliased seconds type DeltaSeconds = Seconds +-- | Alias for RGB (8bit, 8bit, 8bit)+type Color = (Word8, Word8, Word8)++type FrameIndex = Int+ data Frame loc = Frame-  { frameLocation :: loc -- ^ User defined reference to the location of a sprite. For example, a sprite sheet clip.-  , frameDelay :: Seconds -- ^ Minimium amount of time for the frame to last.+  { 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 a loc = Animations { unAnimations :: V.Vector (V.Vector (Frame loc)) }+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 :: (Enum a, Bounded a) => (a -> [Frame loc]) -> Animations a loc+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 :: Enum a => Animations a loc -> a -> V.Vector (Frame loc)-framesByAnimation (Animations as) a = as V.! fromEnum a+framesByAnimation :: Key key => Animations key loc -> key -> V.Vector (Frame loc)+framesByAnimation (Animations as) k = as V.! fromEnum k  data Loop-  = Loop'Forever -- ^ Never stop looping. Animation can never be completed.+  = 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-data Position a = Position-  { positionAnimation :: a -- ^ Index for the animation.-  , positionFrameIndex :: Int -- ^ Index wihin the animation. WARNING: Modifying to below zero or equal-to-or-greater-than-the-frame-count will throw out of bounds errors.-  , positionCounter :: Seconds -- ^ Accumulated seconds to end of the frame. Will continue to compound if animation is completed.-  , positionLoop :: Loop -- ^ How to loop through an animation. Loop'Count is a count down.+-- | `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) --- | You can ignore. An intermediate type for `stepAnimation` to judge how to increment the current frame.+-- | 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 a -> DeltaSeconds -> FrameStep-stepFrame Frame{frameDelay} Position{positionCounter} delta = -  if positionCounter + delta >= frameDelay-    then FrameStep'Delta $ positionCounter + delta - frameDelay-    else FrameStep'Counter $ positionCounter + delta+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 in a new position.-stepAnimation :: Enum a => Animations a loc -> Position a -> DeltaSeconds -> Position a-stepAnimation as p d =+-- | 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{positionCounter = counter }-    FrameStep'Delta delta -> stepAnimation as p' delta+    FrameStep'Counter counter -> p{pCounter = counter }+    FrameStep'Delta delta -> stepPosition as p' delta   where     frameStep = stepFrame f p d-    fs = unAnimations as V.! fromEnum (positionAnimation p)-    f = fs V.! positionFrameIndex p-    p'= case positionLoop p of-      Loop'Forever -> p{positionFrameIndex = (positionFrameIndex p + 1) `mod` V.length fs, positionCounter = 0}+    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 = (positionFrameIndex p + 1) `mod` V.length fs+        index = (pFrameIndex p + 1) `mod` V.length fs         n' = if index == 0 then n - 1 else n         in p-          { positionFrameIndex = if n' < 0 then positionFrameIndex p else index-          , positionCounter = 0-          , positionLoop = Loop'Count n' }+          { 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'Forever, the animation will never be completed.-isAnimationComplete :: Enum a => Animations a loc -> Position a -> Bool-isAnimationComplete as p = case positionLoop p of-  Loop'Forever -> False-  Loop'Count n -> n < 0 && positionFrameIndex p == lastIndex && positionCounter p >= frameDelay lastFrame+--   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 (positionAnimation p)+    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 --- | Simple function diff'ing the position for loop change (tentative)+-- | 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 a -- ^ Previous+  :: Position key -- ^ Previous   -> Position a -- ^ Next   -> Bool-positionHasLooped Position{ positionLoop = Loop'Count c } Position{ positionLoop = Loop'Count c' } = c > c'-positionHasLooped Position{ positionLoop = Loop'Forever } _ = False-positionHasLooped _ Position{ positionLoop = Loop'Forever } = False+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

@@ -1,5 +1,5 @@ name: animate-version: '0.1.0'+version: '0.2.0' category: Game synopsis: Animation for sprites description: Prototypical sprite animation with type-safety.@@ -17,16 +17,23 @@ - LambdaCase - NamedFieldPuns - ScopedTypeVariables+- OverloadedStrings library:   dependencies:   - base >=4.7 && <5+  - aeson+  - bytestring+  - containers+  - text   - vector   source-dirs: library tests:   animate-test-suite:     dependencies:     - base+    - aeson     - animate+    - containers     - hspec     - vector     ghc-options:

@@ -1,68 +1,74 @@-{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-} module Data.AnimateSpec where  import qualified Data.Vector as V import Test.Hspec import Data.Animate -data Animation0 = Animation0Stand | Animation0Walk-  deriving (Show, Eq, Enum, Bounded)+data Ani = Ani'Stand | Ani'Walk+  deriving (Show, Eq, Enum, Ord, Bounded) +instance Key Ani+ spec :: Spec spec = do   describe "mkAnimations" $ do-    let getFrames Animation0Stand = [Frame 'a' 0.2, Frame 'b' 0.2]-        getFrames Animation0Walk = [Frame 'c' 0.2, Frame 'd' 0.2]+    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 Animation0Stand `shouldBe` V.fromList [Frame 'a' 0.2, Frame 'b' 0.2]-      framesByAnimation as Animation0Walk `shouldBe` V.fromList [Frame 'c' 0.2, Frame 'd' 0.2]+      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 { _pAnimation = (0 :: Int), _pFrameIndex = 0, _pCounter = 0.3, _pLoop = LoopForever } delta+      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` (\(FrameStepDelta actual') -> 1e6 > abs (actual' - expected))-  describe "stepAnimation" $ do-    let getFrames Animation0Stand = [Frame 'a' 0.2, Frame 'b' 0.2]-        getFrames Animation0Walk = [Frame 'c' 0.2, Frame 'd' 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 { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopForever }+    let p = Position { pKey = Ani'Stand, pFrameIndex = 0, pCounter = 0, pLoop = Loop'Always }     it "should do nothing if given 0 delta seconds" $ do-      stepAnimation as p 0 `shouldBe` p+      stepPosition as p 0 `shouldBe` p     it "should go to the next frame" $ do-      stepAnimation as p 0.2 `shouldBe` p { _pFrameIndex = 1, _pCounter = 0 }+      stepPosition as p 0.2 `shouldBe` p { pFrameIndex = 1, pCounter = 0 }     it "should loop to the start" $ do-      stepAnimation as p 0.4 `shouldBe` p { _pFrameIndex = 0, _pCounter = 0 }+      stepPosition as p 0.4 `shouldBe` p { pFrameIndex = 0, pCounter = 0 }     it "should loop once" $ do-      stepAnimation as p{ _pLoop = LoopCount 1 } 0.4 `shouldBe` p { _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount 0 }+      stepPosition as p{ pLoop = Loop'Count 1 } 0.4 `shouldBe` p { pFrameIndex = 0, pCounter = 0, pLoop = Loop'Count 0 }     it "should not loop" $ do-      stepAnimation as p{ _pLoop = LoopCount 0 } 0.4 `shouldBe` p { _pFrameIndex = 1, _pCounter = 0, _pLoop = LoopCount (-1) }+      stepPosition as p{ pLoop = Loop'Count 0 } 0.4 `shouldBe` p { pFrameIndex = 1, pCounter = 0, pLoop = Loop'Count (-1) }+   describe "isAnimationComplete" $ do-    let getFrames Animation0Stand = [Frame 'a' 0.2, Frame 'b' 0.2]-        getFrames Animation0Walk = [Frame 'c' 0.2, Frame 'd' 0.2]+    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 { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopForever }+      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 { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount (-1) }+      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 { _pAnimation = Animation0Stand, _pFrameIndex = 1, _pCounter = 0.2, _pLoop = LoopCount (-1) }+      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 { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount 0 }+      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 { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount (-1) }+      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 { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount 0 }-      let p' = Position { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount (-1) }+      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 { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount 0 }-      let p' = Position { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount 0 }+      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