animate (empty) → 0.0.0

raw patch · 9 files changed

+311/−0 lines, 9 filesdep +animatedep +basedep +hspecsetup-changed

Dependencies added: animate, base, hspec, vector

Files

• LICENSE +29/−0
• README.md +2/−0
• Setup.hs +6/−0
• animate.cabal +53/−0
• library/Data/Animate.hs +107/−0
• package.yaml +39/−0
• stack.yaml +6/−0
• test-suite/Data/AnimateSpec.hs +68/−0
• test-suite/Main.hs +1/−0

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2017, Joe Vargas+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+# animate+Animation for sprites

@@ -0,0 +1,6 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple+main :: IO ()+main = Distribution.Simple.defaultMain

@@ -0,0 +1,53 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           animate+version:        0.0.0+synopsis:       Animation for sprites+description:    Prototypical sprite animation with type-safety.+category:       Game+homepage:       https://github.com/jxv/animate#readme+bug-reports:    https://github.com/jxv/animate/issues+maintainer:     Joe Vargas+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    package.yaml+    README.md+    stack.yaml++source-repository head+  type: git+  location: https://github.com/jxv/animate++library+  hs-source-dirs:+      library+  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , vector+  exposed-modules:+      Data.Animate+  default-language: Haskell2010++test-suite animate-test-suite+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test-suite+  default-extensions: DuplicateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving LambdaCase NamedFieldPuns ScopedTypeVariables+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base+    , animate+    , hspec+    , vector+  other-modules:+      Data.AnimateSpec+  default-language: Haskell2010

@@ -0,0 +1,107 @@+module Data.Animate+  ( Seconds+  , DeltaSeconds+  , Frame(..)+  , Animations+  , animations+  , framesByAnimation+  , Loop(..)+  , Position(..)+  , FrameStep(..)+  , stepFrame+  , stepAnimation+  , isAnimationComplete+  , positionHasLooped+  ) where++import qualified Data.Vector as V (Vector, (!), length, fromList)++-- | Avoided newtype wrapper for convenience (tentative)+type Seconds = Float++-- | Type aliased seconds (tentative)+type DeltaSeconds = Seconds++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 a loc = Animations { unAnimations :: V.Vector (V.Vector (Frame loc)) }+  deriving (Show, Eq)++-- | Generate animations given each constructor+animations :: (Enum a, Bounded a) => (a -> [Frame loc]) -> Animations a 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++data Loop+  = LoopForever -- ^ Never stop looping. Animation can never be completed.+  | LoopCount 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+  { _pAnimation :: a -- ^ Index for the animation.+  , _pFrameIndex :: 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.+  , _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. LoopCount is a count down.+  } deriving (Show, Eq)++-- | You can ignore. An intermediate type for `stepAnimation` to judge how to increment the current frame.+data FrameStep+  = FrameStepCounter Seconds -- ^ New counter to compare against the frame's delay.+  | FrameStepDelta 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{_fDelay} Position{_pCounter} delta = +  if _pCounter + delta >= _fDelay+    then FrameStepDelta $ _pCounter + delta - _fDelay+    else FrameStepCounter $ _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 =+  case frameStep of+    FrameStepCounter counter -> p{_pCounter = counter }+    FrameStepDelta delta -> stepAnimation as p' delta+  where+    frameStep = stepFrame f p d+    fs = unAnimations as V.! fromEnum (_pAnimation p)+    f = fs V.! _pFrameIndex p+    p'= case _pLoop p of+      LoopForever -> p{_pFrameIndex = (_pFrameIndex p + 1) `mod` V.length fs, _pCounter = 0}+      LoopCount 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 = LoopCount n' }++-- | The animation has finished all its frames. Useful for signalling into switching to another animation.+--   With a LoopForever, the animation will never be completed.+isAnimationComplete :: Enum a => Animations a loc -> Position a -> Bool+isAnimationComplete as p = case _pLoop p of+  LoopForever -> False+  LoopCount n -> n < 0 && _pFrameIndex p == lastIndex && _pCounter p >= _fDelay lastFrame+  where+    frames = framesByAnimation as (_pAnimation p)+    lastIndex = V.length frames - 1+    lastFrame = frames V.! lastIndex+++-- | Simple function diff'ing the position for loop change (tentative)+positionHasLooped+  :: Position a -- ^ Previous+  -> Position a -- ^ Next+  -> Bool+positionHasLooped Position{ _pLoop = LoopCount c } Position{ _pLoop = LoopCount c' } = c > c'+positionHasLooped Position{ _pLoop = LoopForever } _ = False+positionHasLooped _ Position{ _pLoop = LoopForever } = False

@@ -0,0 +1,39 @@+name: animate+version: '0.0.0'+category: Game+synopsis: Animation for sprites+description: Prototypical sprite animation with type-safety.+maintainer: Joe Vargas+extra-source-files:+- package.yaml+- README.md+- stack.yaml+ghc-options: -Wall+default-extensions:+- DuplicateRecordFields+- FlexibleContexts+- FlexibleInstances+- GeneralizedNewtypeDeriving+- LambdaCase+- NamedFieldPuns+- ScopedTypeVariables+library:+  dependencies:+  - base >=4.7 && <5+  - vector+  source-dirs: library+tests:+  animate-test-suite:+    dependencies:+    - base+    - animate+    - hspec+    - vector+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: Main.hs+    source-dirs: test-suite+github: jxv/animate+license: BSD3

@@ -0,0 +1,6 @@+resolver: lts-8.11+packages:+- '.'+extra-deps: []+flags: {}+extra-package-dbs: []

@@ -0,0 +1,68 @@+{-# LANGUAGE DuplicateRecordFields #-}+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)++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 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]+  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 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]+    let as = animations getFrames+    let p = Position { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopForever }+    it "should do nothing if given 0 delta seconds" $ do+      stepAnimation as p 0 `shouldBe` p+    it "should go to the next frame" $ do+      stepAnimation 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 }+    it "should loop once" $ do+      stepAnimation as p{ _pLoop = LoopCount 1 } 0.4 `shouldBe` p { _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopCount 0 }+    it "should not loop" $ do+      stepAnimation as p{ _pLoop = LoopCount 0 } 0.4 `shouldBe` p { _pFrameIndex = 1, _pCounter = 0, _pLoop = LoopCount (-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 as = animations getFrames+    it "should be incomplete: loop is forever" $ do+      let p = Position { _pAnimation = Animation0Stand, _pFrameIndex = 0, _pCounter = 0, _pLoop = LoopForever }+      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) }+      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) }+      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 }+      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) }+      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) }+      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 }+      positionHasLooped p p' `shouldBe` False

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}