anitomata (empty) → 0.1.0.0

raw patch · 8 files changed

+1371/−0 lines, 8 filesdep +QuickCheckdep +anitomatadep +base

Dependencies added: QuickCheck, anitomata, base, hspec, vector

Files

CHANGELOG.md +3/−0
LICENSE +21/−0
README.md +93/−0
anitomata.cabal +58/−0
library/Anitomata.hs +758/−0
package.yaml +55/−0
test-suite/Driver.hs +1/−0
test-suite/Test/AnitomataSpec.hs +382/−0

+ CHANGELOG.md view

@@ -0,0 +1,3 @@+## 0.1.0.0++* Initial release

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2024 Jason Shipman++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,93 @@+# [anitomata][]++[![Version badge][]][version]++## Synopsis++`anitomata` is a pure implementation of 2D sprite animation intended for use in+gamedev.++In this example, `anim` is an animation for an NPC celebrating a victory. The+animation sequence plays the NPC's `idle` animation two times then the `jump`+animation one time, and the entire sequence is looped indefinitely:++```haskell+import Anitomata+import qualified Data.Vector.Unboxed as U++anim :: Anim+anim =+  buildAnim AnimDurationDefault+    $ repeatAnim AnimRepeatForever+    $ repeatAnim (AnimRepeatCount 1) idle <> jump++idle :: AnimBuilder+idle = fromAnimSlice idleSlice++jump :: AnimBuilder+jump = fromAnimSlice jumpSlice++idleSlice :: AnimSlice+idleSlice =+  AnimSlice+    { animSliceDir = AnimDirBackward+    , animSliceFrameDurs = U.replicate 4 0.1 -- Each frame is 100ms+    , animSliceFrames = U.fromListN 4 [{- ... AnimFrame values ... -}]+    }++jumpSlice :: AnimSlice+jumpSlice =+  AnimSlice+    { animSliceDir = AnimDirForward+      -- Second frame is 500ms, rest are 100ms+    , animSliceFrameDurs = U.generate 8 $ \i -> if i == 1 then 0.5 else 0.1+    , animSliceFrames = U.fromListN 8 [{- ... AnimFrame values ... -}]+    }+```++`AnimSlice` is the smallest building block of an animation. Slices are a minimal+sequence of frames that capture a logical chunk of animation. Slices are+converted to `AnimBuilder` values and then the builders can be combined using+the `Semigroup` interface. Values of the core animation type - `Anim` - are+created from builders.++A game can play an animation by stepping it using `stepAnim` each simulation+frame, passing the time elapsed since the last step:++```haskell+stepAnim :: Double -> Anim -> SteppedAnim++data SteppedAnim = SteppedAnim+  { steppedAnimStatus :: AnimStatus+  , steppedAnimValue :: Anim+  }+```++An animation can be rendered using `animFrame` in conjunction with a spritesheet+that is managed separately by the game. `animFrame` provides the current frame+of the animation:++```haskell+animFrame :: Anim -> AnimFrame+```++Note that the types in the library are more general than what is shown above.+For example, there is no requirement of using `Double` as a duration type,+unboxed `Vector` as the vector type, etc.++The animation building blocks can be defined manually, but this is tedious and+error-prone. Instead, the base slices and builders are typically defined+automatically by feeding a design file - e.g. output from Aseprite - into a code+generator or parsing some translated representation of a design file. Packages+providing this functionality may be found by visiting the project's+[homepage](https://sr.ht/~jship/anitomata/) or by searching Hackage (all+official packages of the `anitomata` project are named `anitomata-*`).++For additional detail on the library, please see the [Haddocks][] and the+[announcement post][].++[anitomata]: <https://git.sr.ht/~jship/anitomata>+[Version badge]: <https://img.shields.io/hackage/v/anitomata?color=brightgreen&label=version&logo=haskell>+[version]: <https://hackage.haskell.org/package/anitomata>+[Haddocks]: <https://hackage.haskell.org/package/anitomata>+[announcement post]: <https://jasonpshipman.com/posts/2024-03-26-announcing-anitomata>

+ anitomata.cabal view

@@ -0,0 +1,58 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name:           anitomata+version:        0.1.0.0+synopsis:       Composable sprite animation+description:    Composable 2D sprite animation in Haskell.+category:       Game+homepage:       https://sr.ht/~jship/anitomata/+author:         Jason Shipman+maintainer:     Jason Shipman+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    CHANGELOG.md+    LICENSE+    package.yaml+    README.md++source-repository head+  type: git+  location: https://git.sr.ht/~jship/anitomata/++library+  exposed-modules:+      Anitomata+  other-modules:+      Paths_anitomata+  hs-source-dirs:+      library+  ghc-options: -Weverything -Wno-missing-local-signatures -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specializations -Wno-all-missed-specializations -Wno-unsafe -Wno-safe -Wno-missing-safe-haskell-mode+  build-depends:+      base >=4.17 && <4.20+    , vector >=0.13.1.0 && <0.14+  default-language: GHC2021++test-suite anitomata-test-suite+  type: exitcode-stdio-1.0+  main-is: Driver.hs+  other-modules:+      Test.AnitomataSpec+      Paths_anitomata+  hs-source-dirs:+      test-suite+  ghc-options: -Weverything -Wno-missing-local-signatures -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specializations -Wno-all-missed-specializations -Wno-unsafe -Wno-safe -Wno-missing-safe-haskell-mode -rtsopts -threaded -with-rtsopts "-N"+  build-tool-depends:+      hspec-discover:hspec-discover+  build-depends:+      QuickCheck+    , anitomata+    , base+    , hspec+    , vector+  default-language: GHC2021

+ library/Anitomata.hs view

@@ -0,0 +1,758 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TypeFamilies #-}+module Anitomata+  ( -- * Synopsis+    -- $synopsis++    -- ** Naming conventions+    -- $naming++    -- * Animations+    Anim, Anim_+    -- ** Playing+  , stepAnim+  , SteppedAnim, SteppedAnim_(..)+  , AnimStatus(..)+    -- ** Rendering+  , animFrame+  , AnimFrame, AnimFrame_(..)+    -- ** Building+  , buildAnim+  , AnimDuration, AnimDuration_(..)+  , AnimBuilder, AnimBuilder_+  , fromAnimSlice+  , pingpongAnimSlice+  , repeatAnim+  , AnimRepeat(..)+    -- *** Slices+  , AnimSlice, AnimSlice_(..)+  , AnimDir(..)+    -- ** Metadata+  , animMeta+  , AnimMeta, AnimMeta_(..)+    -- ** Testing+    -- $testing+  , iterateAnim+  , animSlice+  , animSequence+  ) where++import Control.Monad.ST (ST)+import Data.Int (Int32)+import Data.Kind (Type)+import Data.List.NonEmpty (NonEmpty((:|)))+import Data.Semigroup (Semigroup(stimes))+import Data.Vector.Fusion.Util (Box)+import Prelude+import Text.Printf (printf)+import Text.Show.Functions ()++import Data.List qualified as L+import Data.Vector.Generic qualified as G+import Data.Vector.Generic.Mutable.Base qualified as GMB+import Data.Vector.Unboxed qualified as U++-- | The core animation type.+type Anim :: Type+type Anim = Anim_ U.Vector Double AnimFrame++type Anim_ :: (Type -> Type) -> Type -> Type -> Type+data Anim_ v t f = Anim+  { animElapsed :: !t+  , animIndex :: !Int+  , animUpdateFrameDur :: !(t -> t)+  , animBuilder :: !(AnimBuilder_ v t f)+  } deriving stock (Show)++-- | A source rectangle into a spritesheet.+--+-- The rectangle is defined via the coordinates of its top-left point and its+-- extents.+type AnimFrame :: Type+type AnimFrame = AnimFrame_ Int32++type AnimFrame_ :: Type -> Type+data AnimFrame_ i = AnimFrame+  { animFrameX :: !i -- ^ X coordinate of top-left point in pixels.+  , animFrameY :: !i -- ^ Y coordinate of top-left point in pixels.+  , animFrameW :: !i -- ^ Width in pixels.+  , animFrameH :: !i -- ^ Height in pixels.+  } deriving stock (Eq, Show)++-- | The animation's current frame. Use the frame in conjunction with your+-- game's spritesheet(s) to render an animation.+--+-- In the default config, the result type is 'AnimFrame'. You are free to use+-- any frame type you'd like though.+animFrame :: forall v t f. G.Vector v f => Anim_ v t f -> f+animFrame a = frames G.! idx+  where+  Anim { animIndex = idx, animBuilder = ab } = a+  AnimBuilder { animBuilderSlice = as } = ab+  AnimSlice { animSliceFrames = frames } = as++-- | The animation's current slice.+--+-- The slice returned is the original slice specified at animation build time+-- and its frame durations are /not/ modified to take the animation's specified+-- duration into account.+animSlice :: forall v t f. Anim_ v t f -> AnimSlice_ v t f+animSlice a = animBuilderSlice $ animBuilder a++-- | The animation's current sequence of slices.+--+-- The slices returned are the original slices specified at animation build time+-- and their frame durations are /not/ modified to take the animation's+-- specified duration into account.+animSequence :: forall v t f. Anim_ v t f -> NonEmpty (AnimSlice_ v t f)+animSequence a = as :| rest+  where+  Anim { animBuilder = ab } = a+  AnimBuilder { animBuilderSlice = as, animBuilderNext = rest } = ab++-- | The animation's metadata.+--+-- This function produces 'Nothing' if the animation is infinitely repeating.+animMeta :: forall v t f. Anim_ v t f -> Maybe (AnimMeta_ t)+animMeta Anim { animBuilder = ab }+  | Finite am <- animBuilderMeta ab = Just am+  | otherwise = Nothing++-- | A means for customizing an animation's duration.+--+-- By default (i.e. when using 'AnimDurationDefault'), an animation's duration+-- is dictated by the durations of each individual frame. This is often what you+-- want, as playing the animation in your game will match the timing of playing+-- the animation in your design tool. Sometimes you may want to tweak an+-- animation's duration without redoing or duplicating work in your design tool+-- though, so in these cases, you may find the other branches in this type+-- useful.+type AnimDuration :: Type+type AnimDuration = AnimDuration_ Double++type AnimDuration_ :: Type -> Type+data AnimDuration_ t+  = AnimDurationDefault+    -- ^ Use each frame's default duration.+  | AnimDurationScaled !t+    -- ^ Scale each frame's default duration by the specified value.+    --+    -- For example, you can play an animation twice as fast with+    -- 'AnimDurationScaled' @0.5@.+  | AnimDurationTotal !t+    -- ^ Scale each frame's default duration such that the time required to+    -- play the animation matches the specified total duration.+    --+    -- 'buildAnim' will generate a runtime error if this is used with an+    -- infinitely repeating animation.+  | AnimDurationEachFrame !t+    -- ^ Ignore each frame's default duration, using the specified constant+    -- duration instead.+  | AnimDurationEachFrameFromTotal !t+    -- ^ Ignore each frame's default duration, using a constant duration for each+    -- frame derived from the specified total duration instead.+    --+    -- 'buildAnim' will generate a runtime error if this is used with an+    -- infinitely repeating animation.+  deriving stock (Eq, Show)++-- | Build an animation with a specified duration.+buildAnim+  :: forall v t f+   . (G.Vector v f, Fractional t)+  => AnimDuration_ t+  -> AnimBuilder_ v t f+  -> Anim_ v t f+buildAnim ad ab =+  Anim+    { animElapsed = 0+    , animIndex = startIdx $ animBuilderSlice ab+    , animUpdateFrameDur = updateFrameDur+    , animBuilder = ab+        { animBuilderMeta =+            case animBuilderMeta ab of+              Infinite -> Infinite+              Finite am -> Finite AnimMeta+                { animMetaTotalFrameCount = animMetaTotalFrameCount am+                , animMetaTotalDur =+                    case ad of+                      AnimDurationDefault -> animMetaTotalDur am+                      AnimDurationScaled scale -> scale * animMetaTotalDur am+                      AnimDurationTotal dur -> dur+                      AnimDurationEachFrame dur -> dur * fromIntegral (animMetaTotalFrameCount am)+                      AnimDurationEachFrameFromTotal dur -> dur+                , animMetaMinFrameDur = updateFrameDur $ animMetaMinFrameDur am+                , animMetaMaxFrameDur = updateFrameDur $ animMetaMaxFrameDur am+                }+        }+    }+  where+  updateFrameDur =+    case ad of+      AnimDurationDefault -> id+      AnimDurationScaled scale -> (scale *)+      AnimDurationTotal dur+        | Finite (AnimMeta _ defaultDur _ _) <- animBuilderMeta ab ->+            ((dur / defaultDur) *)+        | otherwise ->+            error $ unwords+              [ "buildAnim: cannot override total duration of infinite"+              , "animation"+              ]+      AnimDurationEachFrame dur -> const dur+      AnimDurationEachFrameFromTotal dur+        | Finite (AnimMeta frameCount _ _ _) <- animBuilderMeta ab ->+            const $ dur / fromIntegral frameCount+        | otherwise ->+            error $ unwords+              [ "buildAnim: cannot override total duration of infinite"+              , "animation"+              ]++type AnimStatus :: Type+data AnimStatus+  = AnimStatusFinished+    -- ^ The animation has finished. Any additional calls to 'stepAnim' will be+    -- no-ops. Stepping an infinitely repeating animation will never produce+    -- this status.+  | AnimStatusPlaying+    -- ^ The animation is actively playing. Stepping an infinitely repeating+    -- animation always produces this status.+  deriving stock (Eq, Show)++-- | 'SteppedAnim' wraps the animation's status and the updated animation value.+type SteppedAnim :: Type+type SteppedAnim = SteppedAnim_ U.Vector Double AnimFrame++type SteppedAnim_ :: (Type -> Type) -> Type -> Type -> Type+data SteppedAnim_ v t f = SteppedAnim+  { steppedAnimStatus :: !AnimStatus+    -- ^ Indicates if the animation has finished or is actively playing.+  , steppedAnimValue :: !(Anim_ v t f)+    -- ^ The updated animation value.+  } deriving stock (Show)++-- | Advance an animation by the given amount of time.+stepAnim+  :: forall v t f+   . (G.Vector v t, G.Vector v f, RealFrac t)+  => t -- ^ An amount of time.+  -> Anim_ v t f+  -> SteppedAnim_ v t f+stepAnim dt a+  | elapsed' < timer =+      if dt == 0 then+        SteppedAnim+          { steppedAnimStatus = AnimStatusPlaying+          , steppedAnimValue = a+          }+      else+        stepAnim 0 a { animElapsed = elapsed' }+  | otherwise =+      if idx == endIdx then+        case s of+          [] ->+            SteppedAnim+              { steppedAnimStatus = AnimStatusFinished+              , steppedAnimValue = a+              }+          next : rest ->+            stepAnim (elapsed' - timer) a+              { animElapsed = 0+              , animIndex = startIdx next+              , animBuilder =+                  AnimBuilder+                    { animBuilderMeta = am+                    , animBuilderSlice = next+                    , animBuilderNext = rest+                    }+              }+      else+        stepAnim (elapsed' - timer) a+          { animElapsed = 0+          , animIndex = idx + idxStep+          }+  where+  elapsed', timer :: t+  elapsed' = elapsed + dt+  timer = updateFrameDur $ frameDurs G.! idx++  idxStep, endIdx :: Int+  (idxStep, endIdx) =+    case dir of+      AnimDirForward -> (1, G.length frames - 1)+      AnimDirBackward -> (-1, 0)++  Anim+    { animElapsed = elapsed+    , animIndex = idx+    , animUpdateFrameDur = updateFrameDur+    , animBuilder = ab+    } = a++  AnimBuilder+    { animBuilderMeta = am+    , animBuilderSlice = as+    , animBuilderNext = s+    } = ab++  AnimSlice+    { animSliceDir = dir+    , animSliceFrameDurs = frameDurs+    , animSliceFrames = frames+    } = as++-- | Repeatedly step an animation using a fixed timestep, producing a stream of+-- updated animations until the animation is finished.+--+-- If the input animation is infinitely repeating, this function produces an+-- infinite list.+iterateAnim+  :: forall v t f+   . (G.Vector v t, G.Vector v f, RealFrac t)+  => t+  -> Anim_ v t f+  -> [SteppedAnim_ v t f]+iterateAnim dt a0 =+  takeUntilDone $ L.iterate (stepAnim dt . steppedAnimValue) $ stepAnim dt a0++takeUntilDone :: forall v t f. [SteppedAnim_ v t f] -> [SteppedAnim_ v t f]+takeUntilDone = \case+  [] -> []+  sa : rest+    | AnimStatusPlaying <- steppedAnimStatus sa ->+        sa : takeUntilDone rest+    | otherwise ->+        [sa]++startIdx :: forall v t f. G.Vector v f => AnimSlice_ v t f -> Int+startIdx as =+  case animSliceDir as of+    AnimDirForward -> 0+    AnimDirBackward -> G.length (animSliceFrames as) - 1++-- | An animation builder.+--+-- Convert slices to builders via 'fromAnimSlice' and 'pingpongAnimSlice'.+-- Builders may then be combined via the 'Semigroup' interface and their+-- animation sequences may be repeated via 'repeatAnim'.+type AnimBuilder :: Type+type AnimBuilder = AnimBuilder_ U.Vector Double AnimFrame++type AnimBuilder_ :: (Type -> Type) -> Type -> Type -> Type+data AnimBuilder_ v t f = AnimBuilder+  { animBuilderMeta :: !(Countable (AnimMeta_ t))+  , animBuilderSlice :: !(AnimSlice_ v t f)+  , animBuilderNext :: ![AnimSlice_ v t f]+  } deriving stock (Eq, Show)++instance RealFrac t => Semigroup (AnimBuilder_ v t f) where+  (<>) :: AnimBuilder_ v t f -> AnimBuilder_ v t f -> AnimBuilder_ v t f+  x <> y =+    AnimBuilder+      { animBuilderMeta =+          animBuilderMeta x <> animBuilderMeta y+      , animBuilderSlice = animBuilderSlice x+      , animBuilderNext =+          animBuilderNext x ++ (animBuilderSlice y : animBuilderNext y)+      }++  stimes :: Integral b => b -> AnimBuilder_ v t f -> AnimBuilder_ v t f+  stimes n x+    | n <= 0 = error "AnimBuilder_.stimes: positive multiplier expected"+    | otherwise = go n+    where+    go = \case+      1 -> x+      i -> x <> go (i - 1)++-- | Create a builder from a single slice.+fromAnimSlice+  :: forall v t f+   . (G.Vector v t, G.Vector v f, RealFrac t)+  => AnimSlice_ v t f+  -> AnimBuilder_ v t f+fromAnimSlice as+  | frameDursLen /= framesLen =+      let errMsg = unwords+            [ "fromAnimSlice: mismatch between frame duration vector size (%d)"+            , "and source rectangle vector size (%d)"+            ]+       in error $ printf errMsg frameDursLen framesLen+  | frameDursLen < 1 =+      error "fromAnimSlice: empty frame duration and source rectangle vectors"+  | otherwise =+      AnimBuilder+        { animBuilderMeta =+            Finite AnimMeta+              { animMetaTotalFrameCount = framesLen+              , animMetaTotalDur = G.sum frameDurs+              , animMetaMinFrameDur = G.minimum frameDurs+              , animMetaMaxFrameDur = G.maximum frameDurs+              }+        , animBuilderSlice = as+        , animBuilderNext = []+        }+  where+  frameDursLen, framesLen :: Int+  frameDursLen = G.length frameDurs+  framesLen = G.length frames++  AnimSlice+    { animSliceFrameDurs = frameDurs+    , animSliceFrames = frames+    } = as++-- | Create a builder from a single slice, where the animation sequence is the+-- slice first played in its defined direction and then played in its opposite+-- direction.+--+-- This is provided for convenience. You may achieve the same result using the+-- 'Semigroup' interface and futzing with the animation directions:+--+-- @+-- builder :: 'AnimBuilder'+-- builder = fromAnimSlice slice '<>' fromAnimSlice slice+--   { 'animSliceDir' =+--       case 'animSliceDir' slice of+--         'AnimDirForward' -> 'AnimDirBackward'+--         'AnimDirBackward' -> 'AnimDirForward'+--   }+--+-- slice :: 'AnimSlice'+-- @+pingpongAnimSlice+  :: forall v t f+   . (G.Vector v t, G.Vector v f, RealFrac t)+  => AnimSlice_ v t f+  -> AnimBuilder_ v t f+pingpongAnimSlice as = ab <> ab'+  where+  ab = fromAnimSlice as+  ab' = ab { animBuilderSlice = reverseAnimSlice as }++-- | Repeat a builder's animation sequence.+repeatAnim+  :: forall v t f+   . RealFrac t+  => AnimRepeat+  -> AnimBuilder_ v t f+  -> AnimBuilder_ v t f+repeatAnim ar ab =+  case ar of+    AnimRepeatForever ->+      let ab' = ab { animBuilderMeta = Infinite } <> ab' in ab'+    AnimRepeatCount n+      | n <= 0 -> ab+      | otherwise -> stimes (1 + n) ab++-- | Animation metadata.+type AnimMeta :: Type+type AnimMeta = AnimMeta_ Double++type AnimMeta_ :: Type -> Type+data AnimMeta_ t = AnimMeta+  { animMetaTotalFrameCount :: !Int+  , animMetaTotalDur :: !t+  , animMetaMinFrameDur :: !t+  , animMetaMaxFrameDur :: !t+  } deriving stock (Eq, Show)++instance RealFrac t => Semigroup (AnimMeta_ t) where+  (<>) :: AnimMeta_ t -> AnimMeta_ t -> AnimMeta_ t+  x <> y =+    AnimMeta+      { animMetaTotalFrameCount =+          animMetaTotalFrameCount x + animMetaTotalFrameCount y+      , animMetaTotalDur = animMetaTotalDur x + animMetaTotalDur y+      , animMetaMinFrameDur =+          min (animMetaMinFrameDur x) (animMetaMinFrameDur y)+      , animMetaMaxFrameDur =+          max (animMetaMaxFrameDur x) (animMetaMaxFrameDur y)+      }++-- | A single, logical sequence of animation frames. A slice captures a+-- direction, a vector of frames, and a vector of frame durations. The sizes of+-- the two vectors must match.+--+-- While you are technically free to create an animation out of a bunch of+-- single-frame slices, it is recommended for performance's sake that each slice+-- is defined with as many frames as necessary to capture a logical chunk of+-- animation.+--+-- If you use a code generator or parser to produce your slices, additional+-- performance gains are available. These utilities typically produce a single+-- vector of frames and a single vector of durations encompassing all the+-- animation slices in your spritesheet. Then the produced animation slices+-- refer to these two "megavectors" via /vector/ slices (mind the overloaded+-- "slice" word) and avoid copying any frame and duration data. This makes the+-- use and reuse of animation slices very cheap.+type AnimSlice :: Type+type AnimSlice = AnimSlice_ U.Vector Double AnimFrame++type AnimSlice_ :: (Type -> Type) -> Type -> Type -> Type+data AnimSlice_ v t f = AnimSlice+  { animSliceDir :: !AnimDir+  , animSliceFrameDurs :: !(v t)+  , animSliceFrames :: !(v f)+  } deriving stock (Eq, Show)++reverseAnimSlice :: forall v t f. AnimSlice_ v t f -> AnimSlice_ v t f+reverseAnimSlice as = as { animSliceDir = reverseAnimDir $ animSliceDir as }++type AnimDir :: Type+data AnimDir+  = AnimDirForward -- ^ The slice is to be played forward.+  | AnimDirBackward -- ^ The slice is to be played in reverse.+  deriving stock (Eq, Show)++reverseAnimDir :: AnimDir -> AnimDir+reverseAnimDir = \case+  AnimDirForward -> AnimDirBackward+  AnimDirBackward -> AnimDirForward++type AnimRepeat :: Type+data AnimRepeat+  = AnimRepeatForever+    -- ^ Repeat the animation sequence infinitely.+  | AnimRepeatCount !Int+    -- ^ Repeat the animation sequence a finite number of times+  deriving stock (Show)++type Countable :: Type -> Type+data Countable a+  = Infinite+  | Finite !a+  deriving stock (Eq, Show)++instance (Semigroup a) => Semigroup (Countable a) where+  (<>) :: Countable a -> Countable a -> Countable a+  Finite x <> Finite y = Finite $ x <> y+  _ <> _ = Infinite++data instance U.MVector s (AnimFrame_ a) =+  MV_AnimFrame {-# UNPACK #-} !Int !(U.MVector s a)++data instance U.Vector (AnimFrame_ a) =+  V_AnimFrame {-# UNPACK #-} !Int !(U.Vector a)++instance U.Unbox a => GMB.MVector U.MVector (AnimFrame_ a) where+  {-# INLINE basicLength #-}+  basicLength :: U.MVector s (AnimFrame_ a) -> Int+  basicLength (MV_AnimFrame n _) = n++  {-# INLINE basicUnsafeSlice #-}+  basicUnsafeSlice+    :: Int+    -> Int+    -> U.MVector s (AnimFrame_ a)+    -> U.MVector s (AnimFrame_ a)+  basicUnsafeSlice m n (MV_AnimFrame _ rects) =+    MV_AnimFrame n (GMB.basicUnsafeSlice (4 * m) (4 * n) rects)++  {-# INLINE basicOverlaps #-}+  basicOverlaps+    :: U.MVector s (AnimFrame_ a)+    -> U.MVector s (AnimFrame_ a)+    -> Bool+  basicOverlaps (MV_AnimFrame _ rects1) (MV_AnimFrame _ rects2) =+    GMB.basicOverlaps rects1 rects2++  {-# INLINE basicUnsafeNew #-}+  basicUnsafeNew :: Int -> ST s (U.MVector s (AnimFrame_ a))+  basicUnsafeNew n = MV_AnimFrame n <$> GMB.basicUnsafeNew (4 * n)++  {-# INLINE basicUnsafeRead #-}+  basicUnsafeRead+    :: U.MVector s (AnimFrame_ a)+    -> Int+    -> ST s (AnimFrame_ a)+  basicUnsafeRead (MV_AnimFrame _ rects) i =+    AnimFrame+      <$> GMB.basicUnsafeRead rects offset+      <*> GMB.basicUnsafeRead rects (1 + offset)+      <*> GMB.basicUnsafeRead rects (2 + offset)+      <*> GMB.basicUnsafeRead rects (3 + offset)+    where+    offset = 4 * i++  {-# INLINE basicUnsafeWrite #-}+  basicUnsafeWrite+    :: U.MVector s (AnimFrame_ a)+    -> Int+    -> AnimFrame_ a+    -> ST s ()+  basicUnsafeWrite (MV_AnimFrame _ rects) i x = do+    GMB.basicUnsafeWrite rects offset animFrameX+    GMB.basicUnsafeWrite rects (1 + offset) animFrameY+    GMB.basicUnsafeWrite rects (2 + offset) animFrameW+    GMB.basicUnsafeWrite rects (3 + offset) animFrameH+    where+    offset = 4 * i+    AnimFrame+      { animFrameX+      , animFrameY+      , animFrameW+      , animFrameH+      } = x++  {-# INLINE basicInitialize #-}+  basicInitialize :: U.MVector s (AnimFrame_ a) -> ST s ()+  basicInitialize (MV_AnimFrame _ rects) = GMB.basicInitialize rects++instance U.Unbox a => G.Vector U.Vector (AnimFrame_ a) where+  {-# INLINE basicUnsafeFreeze #-}+  basicUnsafeFreeze+    :: G.Mutable U.Vector s (AnimFrame_ a)+    -> ST s (U.Vector (AnimFrame_ a))+  basicUnsafeFreeze (MV_AnimFrame n rects) =+    V_AnimFrame n <$> G.basicUnsafeFreeze rects++  {-# INLINE basicUnsafeThaw #-}+  basicUnsafeThaw+    :: U.Vector (AnimFrame_ a)+    -> ST s (G.Mutable U.Vector s (AnimFrame_ a))+  basicUnsafeThaw (V_AnimFrame n rects) =+    MV_AnimFrame n <$> G.basicUnsafeThaw rects++  {-# INLINE basicLength #-}+  basicLength :: U.Vector (AnimFrame_ a) -> Int+  basicLength (V_AnimFrame n _) = n++  {-# INLINE basicUnsafeSlice #-}+  basicUnsafeSlice+    :: Int+    -> Int+    -> U.Vector (AnimFrame_ a)+    -> U.Vector (AnimFrame_ a)+  basicUnsafeSlice m n (V_AnimFrame _ rects) =+    V_AnimFrame n $ G.basicUnsafeSlice (4 * m) (4 * n) rects++  {-# INLINE basicUnsafeIndexM #-}+  basicUnsafeIndexM :: U.Vector (AnimFrame_ a) -> Int -> Box (AnimFrame_ a)+  basicUnsafeIndexM (V_AnimFrame _ rects) i =+    AnimFrame+      <$> G.basicUnsafeIndexM rects offset+      <*> G.basicUnsafeIndexM rects (1 + offset)+      <*> G.basicUnsafeIndexM rects (2 + offset)+      <*> G.basicUnsafeIndexM rects (3 + offset)+    where+    offset = 4 * i++instance U.Unbox a => U.Unbox (AnimFrame_ a)++{- $synopsis++@anitomata@ is a pure implementation of 2D sprite animation intended for use in+gamedev.++In this example, @anim@ is an animation for an NPC celebrating a victory. The+animation sequence plays the NPC's @idle@ animation two times then the @jump@+animation one time, and the entire sequence is looped indefinitely:++@+import Anitomata+import qualified Data.Vector.Unboxed as U++anim :: 'Anim'+anim =+  'buildAnim' 'AnimDurationDefault'+    $ 'repeatAnim' 'AnimRepeatForever'+    $ 'repeatAnim' ('AnimRepeatCount' 1) idle <> jump++idle :: 'AnimBuilder'+idle = 'fromAnimSlice' idleSlice++jump :: 'AnimBuilder'+jump = 'fromAnimSlice' jumpSlice++idleSlice :: 'AnimSlice'+idleSlice =+  'AnimSlice'+    { 'animSliceDir' = 'AnimDirBackward'+    , 'animSliceFrameDurs' = 'U.replicate' 4 0.1 -- Each frame is 100ms+    , 'animSliceFrames' = 'U.fromListN' 4 [{- ... AnimFrame values ... -}]+    }++jumpSlice :: 'AnimSlice'+jumpSlice =+  'AnimSlice'+    { 'animSliceDir' = 'AnimDirForward'+      -- Second frame is 500ms, rest are 100ms+    , 'animSliceFrameDurs' = 'U.generate' 8 $ \\i -> if i == 1 then 0.5 else 0.1+    , 'animSliceFrames' = 'U.fromListN' 8 [{- ... AnimFrame values ... -}]+    }+@++'AnimSlice' is the smallest building block of an animation. Slices are a minimal+sequence of frames that capture a logical chunk of animation. Slices are+converted to 'AnimBuilder' values and then the builders can be combined using+the 'Semigroup' interface. Values of the core animation type - 'Anim' - are+created from builders.++A game can play an animation by stepping it using 'stepAnim' each simulation+frame, passing the time elapsed since the last step:++@+stepAnim :: 'Double' -> 'Anim' -> 'SteppedAnim'++data SteppedAnim = SteppedAnim+  { steppedAnimStatus :: 'AnimStatus'+  , steppedAnimValue :: 'Anim'+  }+@++An animation can be rendered using `animFrame` in conjunction with a spritesheet+that is managed separately by the game. `animFrame` provides the current frame+of the animation:++@+animFrame :: 'Anim' -> 'AnimFrame'+@++Note that the types in the library are more general than what is shown above.+For example, there is no requirement of using 'Double' as a duration type,+unboxed 'U.Vector' as the vector type, etc.++The animation building blocks can be defined manually, but this is tedious and+error-prone. Instead, the base slices and builders are typically defined+automatically by feeding a design file - e.g. output from Aseprite - into a code+generator or parsing some translated representation of a design file. Packages+providing this functionality may be found by visiting the project's+[homepage](https://sr.ht/~jship/anitomata/) or by searching Hackage (all+official packages of the @anitomata@ project are named @anitomata-*@).+-}++{- $naming++This library uses a naming convention on type constructors. Consider 'Anim'+and 'Anim_': 'Anim_' is the type constructor and so is suffixed with an+underscore. 'Anim' is a type alias for 'Anim_' with sensible defaults filled+in for all the type parameters. If you are getting started with the library,+it is recommended to use the type aliases. When looking at type signatures in+the documentation, it may be helpful to mentally substitute the simpler type+aliases in for the more general type constructor applications. If the docs+mention the "default config", this is shorthand for the prescribed defaults+from the aliases.++The library also aims to be consistent with its naming of type parameters:+++------+---------------------------+--------------------++| Name | Meaning                   | Default config     |++======+===========================+====================++| @v@  | A vector type constructor | Unboxed 'U.Vector' |++------+---------------------------+--------------------++| @t@  | A duration type           | 'Double'           |++------+---------------------------+--------------------++| @f@  | A frame type              | 'AnimFrame'        |++------+---------------------------+--------------------++| @i@  | An integral type          | 'Int32'            |++------+---------------------------+--------------------++-}++{- $testing++You __really__ shouldn't need anything from this section! These functions are+only provided to aid in testing and debugging.+-}

+ package.yaml view

@@ -0,0 +1,55 @@+name: anitomata+version: 0.1.0.0+homepage: https://sr.ht/~jship/anitomata/+git: https://git.sr.ht/~jship/anitomata/+license: MIT+license-file: LICENSE+author: Jason Shipman+maintainer: Jason Shipman+synopsis: Composable sprite animation+description: |+  Composable 2D sprite animation in Haskell.+category: Game++extra-source-files:+- CHANGELOG.md+- LICENSE+- package.yaml+- README.md++language: GHC2021++ghc-options:+# Draws heavy inspiration from this list: https://medium.com/mercury-bank/enable-all-the-warnings-a0517bc081c3+- -Weverything+- -Wno-missing-local-signatures # Warns if polymorphic local bindings do not have signatures+- -Wno-missing-exported-signatures # missing-exported-signatures turns off the more strict -Wmissing-signatures. See https://ghc.haskell.org/trac/ghc/ticket/14794#ticket+- -Wno-missing-import-lists # Requires explicit imports of _every_ function (e.g. ‘$’); too strict+- -Wno-missed-specializations # When GHC can’t specialize a polymorphic function+- -Wno-all-missed-specializations # See missed-specializations+- -Wno-unsafe # Don’t use Safe Haskell warnings+- -Wno-safe # Don’t use Safe Haskell warnings+- -Wno-missing-safe-haskell-mode # Don't warn if the Safe Haskell mode is unspecified++library:+  dependencies:+  - base >= 4.17 && <4.20+  - vector >= 0.13.1.0 && <0.14+  source-dirs: library++tests:+  anitomata-test-suite:+    source-dirs: test-suite+    main: Driver.hs+    build-tools:+    - hspec-discover+    dependencies:+    - QuickCheck+    - anitomata+    - base+    - hspec+    - vector+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts "-N"

+ test-suite/Driver.hs view

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

+ test-suite/Test/AnitomataSpec.hs view

@@ -0,0 +1,382 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE LambdaCase #-}+module Test.AnitomataSpec+  ( spec+  ) where++import Anitomata+import Control.Exception (ErrorCall(..), evaluate, try)+import Data.Function ((&), on)+import Data.Functor ((<&>))+import Data.Kind (Type)+import Data.Maybe (isJust, isNothing)+import Data.Proxy (Proxy(Proxy))+import Data.Semigroup (Semigroup(sconcat))+import GHC.TypeLits (KnownNat, Nat, natVal)+import Prelude+import Test.Hspec (Spec, describe, parallel)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck+  ( Arbitrary(arbitrary), NonNegative(getNonNegative), Positive(Positive, getPositive), (.&&.)+  , (===), (==>), Gen, chooseInt, frequency, ioProperty, listOf1, mapSize, oneof, vectorOf+  )++import Data.List qualified as L+import Data.List.NonEmpty qualified as NonEmpty+import Data.Vector qualified as V+import Data.Vector.Generic qualified as G++spec :: Spec+spec = parallel do+  describe "Foo.Data.Anim" do+    prop "Initial source rect is correct" \case+      FiniteTestAnim (TestAnim a) ->+        animFrame a === case animSlice a of+          AnimSlice { animSliceDir = dir, animSliceFrames = frames }+            | dir == AnimDirForward -> V.head frames+            | otherwise -> V.last frames++    prop "Finite animations can be stepped to completion" \case+      FiniteTestAnim (TestAnim a) ->+        -- Use the computed total duration as the delta time so that we can+        -- get through the animation quickly.+        iterateAnim dur a+          & fmap fromSteppedAnim+          & L.lookup AnimStatusFinished+          & isJust+        where+        Just AnimMeta { animMetaTotalDur = dur } = animMeta a++    prop "No frames are skipped if delta time is small enough" $ mapSize (`div` 2) \case+      FiniteTestAnimBuilder (TestAnimBuilder ab) ->+        expectedFrames `L.isSubsequenceOf` realFrames+          .&&. length expectedFrames === totalFrameCount+          .&&. iterDur - totalDur >= 0+          .&&. iterDur - totalDur < dt+        where+        expectedFrames = getExpectedFrames a0+        realFrames = getRealFrames $ iterateAnim dt a0+        iterDur = dt * fromIntegral (length realFrames)+        a0 = buildAnim AnimDurationDefault ab+        dt = minFrameDur / 2+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCount+          , animMetaTotalDur = totalDur+          , animMetaMinFrameDur = minFrameDur+          } = animMeta a0++    prop "Some frames are skipped if delta time is large enough" \case+      FiniteTestAnimBuilder (TestAnimBuilder ab) ->+        length expectedFrames >= length realFrames+          .&&. iterDur - totalDur >= 0+          .&&. iterDur - totalDur < dt+        where+        expectedFrames = getExpectedFrames a0+        realFrames = getRealFrames $ iterateAnim dt a0+        iterDur = dt * fromIntegral (length realFrames)+        a0 = buildAnim AnimDurationDefault ab+        dt = maxFrameDur * 2+        Just AnimMeta+          { animMetaTotalDur = totalDur+          , animMetaMaxFrameDur = maxFrameDur+          } = animMeta a0++    prop "Duration of finite animations can be scaled" \case+      (FiniteTestAnimBuilder (TestAnimBuilder ab), Positive scaleFactor) ->+        scaleFactor * iterDurDefault === iterDurScaled+          .&&. scaleFactor * totalDurDefault === totalDurScaled+          .&&. scaleFactor * minFrameDurDefault === minFrameDurScaled+          .&&. scaleFactor * maxFrameDurDefault === maxFrameDurScaled+          .&&. totalFrameCountDefault === totalFrameCountScaled+        where+        stepCountScaled = length $ iterateAnim dtScaled aScaled+        iterDurScaled = dtScaled * fromIntegral stepCountScaled+        aScaled = buildAnim (AnimDurationScaled scaleFactor) ab+        dtScaled = maxFrameDurScaled+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCountScaled+          , animMetaTotalDur = totalDurScaled+          , animMetaMinFrameDur = minFrameDurScaled+          , animMetaMaxFrameDur = maxFrameDurScaled+          } = animMeta aScaled++        stepCountDefault = length $ iterateAnim dtDefault aDefault+        iterDurDefault = dtDefault * fromIntegral stepCountDefault+        aDefault = buildAnim AnimDurationDefault ab+        dtDefault = maxFrameDurDefault+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCountDefault+          , animMetaTotalDur = totalDurDefault+          , animMetaMinFrameDur = minFrameDurDefault+          , animMetaMaxFrameDur = maxFrameDurDefault+          } = animMeta aDefault++    prop "Total duration of finite animations can be set while respecting relative frame timings" \case+      (FiniteTestAnimBuilder (TestAnimBuilder ab), Positive newTotalDur) ->+        totalDur === newTotalDur+          .&&. iterDur - newTotalDur >= 0+          .&&. iterDur - newTotalDur < dt+          .&&. scaleFactor * minFrameDurDefault === minFrameDur+          .&&. scaleFactor * maxFrameDurDefault === maxFrameDur+          .&&. totalFrameCountDefault === totalFrameCount+        where+        stepCount = length $ iterateAnim dt a'+        iterDur = dt * fromIntegral stepCount+        a' = buildAnim (AnimDurationTotal newTotalDur) ab+        dt = maxFrameDur+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCount+          , animMetaTotalDur = totalDur+          , animMetaMinFrameDur = minFrameDur+          , animMetaMaxFrameDur = maxFrameDur+          } = animMeta a'++        scaleFactor = newTotalDur / totalDurDefault++        a = buildAnim AnimDurationDefault ab+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCountDefault+          , animMetaTotalDur = totalDurDefault+          , animMetaMinFrameDur = minFrameDurDefault+          , animMetaMaxFrameDur = maxFrameDurDefault+          } = animMeta a++    prop "Constant frame duration of finite animations can be set" \case+      (FiniteTestAnimBuilder (TestAnimBuilder ab), Positive frameDur) ->+        iterDur - frameDur * fromIntegral totalFrameCount >= 0+          .&&. iterDur - frameDur * fromIntegral totalFrameCount < dt+          .&&. minFrameDur === frameDur+          .&&. maxFrameDur === frameDur+          .&&. totalFrameCountDefault === totalFrameCount+        where+        stepCount = length $ iterateAnim dt a'+        iterDur = dt * fromIntegral stepCount+        a' = buildAnim (AnimDurationEachFrame frameDur) ab+        dt = maxFrameDur+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCount+          , animMetaMinFrameDur = minFrameDur+          , animMetaMaxFrameDur = maxFrameDur+          } = animMeta a'++        a = buildAnim AnimDurationDefault ab+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCountDefault+          } = animMeta a++    prop "Total duration of finite animations can be set via constant frame timing" \case+      (FiniteTestAnimBuilder (TestAnimBuilder ab), Positive newTotalDur) ->+        totalDur === newTotalDur+          .&&. iterDur - newTotalDur >= 0+          .&&. iterDur - newTotalDur < dt+          .&&. minFrameDur === frameDur+          .&&. maxFrameDur === frameDur+          .&&. totalFrameCountDefault === totalFrameCount+        where+        stepCount = length $ iterateAnim dt a'+        iterDur = dt * fromIntegral stepCount+        a' = buildAnim (AnimDurationEachFrameFromTotal newTotalDur) ab+        dt = maxFrameDur+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCount+          , animMetaTotalDur = totalDur+          , animMetaMinFrameDur = minFrameDur+          , animMetaMaxFrameDur = maxFrameDur+          } = animMeta a'++        frameDur = newTotalDur / fromIntegral totalFrameCount++        a = buildAnim AnimDurationDefault ab+        Just AnimMeta+          { animMetaTotalFrameCount = totalFrameCountDefault+          } = animMeta a++    prop "Stepping a completed animation is idempotent" \case+      (FiniteTestAnim (TestAnim a), Positive dt) ->+        ((==) `on` animFrame . steppedAnimValue) sa $ stepAnim dt $ steppedAnimValue sa+        where+        sa = last $ iterateAnim dt a++    prop "Infinite animations do not have countable metadata" \case+      (InfiniteTestAnimBuilder (TestAnimBuilder ab), TestAnimDuration ad) ->+        validDur ad ==> isNothing $ animMeta $ buildAnim ad ab++    prop "Infinite animations cannot override total duration" \case+      (InfiniteTestAnimBuilder (TestAnimBuilder ab), TestAnimDuration ad) ->+        invalidInfiniteDur ad ==> ioProperty do+          try (evaluate $ buildAnim ad ab) >>= \case+            Left (ErrorCall msg) -> pure $ "buildAnim: " `L.isPrefixOf` msg+            Right {} -> pure False++    prop "Repeating a finite animation some finite number of times" \case+      (TestAnimSlice as, (TestAnimRepeat ar) :: TestAnimRepeat 1 0, TestAnimDuration ad) ->+        getExpectedFrames a === take (succ n * sliceLen) (cycle $ getSliceFrames as)+        where+        a = buildAnim ad ab+        ab = repeatAnim ar $ fromAnimSlice as+        sliceLen = V.length $ animSliceFrames as+        n = case ar of+          AnimRepeatCount x -> x+          AnimRepeatForever -> error "impossible"++    prop "An infinite animation is \"infinite\"" \case+      (TestAnimSlice as, TestAnimDuration ad, Positive n) ->+        validDur ad && n > sliceLen ==>+        take (n * sliceLen) (getExpectedFrames a) ===+          take (n * sliceLen) (cycle $ getSliceFrames as)+        where+        a = buildAnim ad ab+        ab = repeatAnim AnimRepeatForever $ fromAnimSlice as+        sliceLen = V.length $ animSliceFrames as++    prop "An infinite pingponging animation is \"infinite\"" \case+      (TestAnimSlice as, TestAnimDuration ad, Positive n) ->+        validDur ad ==>+        take (n * sliceLen) (getExpectedFrames a) ===+          take (n * sliceLen) (cycle $ sliceFrames <> reverse sliceFrames)+        where+        sliceFrames = getSliceFrames as+        a = buildAnim ad ab+        ab = repeatAnim AnimRepeatForever $ pingpongAnimSlice as+        sliceLen = V.length $ animSliceFrames as++getExpectedFrames :: G.Vector v f => Anim_ v t f -> [f]+getExpectedFrames a0 = foldMap getSliceFrames $ animSequence a0++getSliceFrames :: G.Vector v f => AnimSlice_ v t f -> [f]+getSliceFrames AnimSlice { animSliceDir = dir, animSliceFrames = frames }+  | AnimDirForward <- dir = G.toList frames+  | otherwise = G.toList $ G.reverse frames++getRealFrames :: G.Vector v f => [SteppedAnim_ v t f] -> [f]+getRealFrames = fmap \case+  SteppedAnim { steppedAnimValue = a } -> animFrame a++validDur :: AnimDuration_ t -> Bool+validDur = \case+  AnimDurationDefault -> True+  AnimDurationScaled {} -> True+  AnimDurationTotal {} -> False+  AnimDurationEachFrame {} -> True+  AnimDurationEachFrameFromTotal {} -> False++invalidInfiniteDur :: AnimDuration_ t -> Bool+invalidInfiniteDur = \case+  AnimDurationDefault -> False+  AnimDurationScaled {} -> False+  AnimDurationTotal {} -> True+  AnimDurationEachFrame {} -> False+  AnimDurationEachFrameFromTotal {} -> True++type FiniteTestAnim :: Type+newtype FiniteTestAnim = FiniteTestAnim (TestAnim 1 0)+  deriving newtype (Arbitrary, Show)++type InfiniteTestAnim :: Type+newtype InfiniteTestAnim = InfiniteTestAnim (TestAnim 0 1)+  deriving newtype (Arbitrary, Show)++type TestAnim :: Nat -> Nat -> Type+newtype TestAnim nf ni = TestAnim (Anim_ V.Vector Rational AnimFrame)+  deriving newtype (Show)++instance (KnownNat nf, KnownNat ni) => Arbitrary (TestAnim nf ni) where+  arbitrary :: Gen (TestAnim nf ni)+  arbitrary = do+    TestAnimDuration dur <- arbitrary+    TestAnimBuilder builder <- arbitrary @(TestAnimBuilder nf ni)+    pure $ TestAnim $ buildAnim dur builder++type FiniteTestAnimBuilder :: Type+newtype FiniteTestAnimBuilder = FiniteTestAnimBuilder (TestAnimBuilder 1 0)+  deriving newtype (Arbitrary, Show)++type InfiniteTestAnimBuilder :: Type+newtype InfiniteTestAnimBuilder = InfiniteTestAnimBuilder (TestAnimBuilder 0 1)+  deriving newtype (Arbitrary, Show)++type TestAnimBuilder :: Nat -> Nat -> Type+newtype TestAnimBuilder nf ni = TestAnimBuilder (AnimBuilder_ V.Vector Rational AnimFrame)+  deriving newtype (Semigroup, Show)++instance (KnownNat nf, KnownNat ni) => Arbitrary (TestAnimBuilder nf ni) where+  arbitrary :: Gen (TestAnimBuilder nf ni)+  arbitrary = do+    sconcat . NonEmpty.fromList <$> listOf1 do+      mkBuilder <- genMkAnimBuilder+      TestAnimSlice slice <- arbitrary+      TestAnimRepeat rep <- arbitrary @(TestAnimRepeat nf ni)+      pure $ TestAnimBuilder $ repeatAnim rep $ mkBuilder slice++type TestAnimSlice :: Type+newtype TestAnimSlice = TestAnimSlice (AnimSlice_ V.Vector Rational AnimFrame)+  deriving newtype (Show)++instance Arbitrary TestAnimSlice where+  arbitrary :: Gen TestAnimSlice+  arbitrary = do+    TestAnimDir dir <- arbitrary+    len <- chooseInt (1, 3)+    frameDurs <- do+      positiveDurs <- fmap getPositive <$> vectorOf len arbitrary+      pure $ V.fromListN len positiveDurs+    frames <- do+      rects <- vectorOf len genAnimFrame+      pure $ V.fromListN len rects+    pure $ TestAnimSlice AnimSlice+      { animSliceDir = dir+      , animSliceFrameDurs = frameDurs+      , animSliceFrames = frames+      }++type TestAnimDuration :: Type+newtype TestAnimDuration = TestAnimDuration (AnimDuration_ Rational)+  deriving stock (Show)++instance Arbitrary TestAnimDuration where+  arbitrary :: Gen TestAnimDuration+  arbitrary =+    TestAnimDuration <$> frequency+      [ (4, pure AnimDurationDefault)+      , (1, AnimDurationScaled . getNonNegative <$> arbitrary)+      , (1, AnimDurationTotal . getPositive <$> arbitrary)+      , (1, AnimDurationEachFrame . getNonNegative <$> arbitrary)+      , (1, AnimDurationEachFrameFromTotal . getPositive <$> arbitrary)+      ]++type TestAnimDir :: Type+newtype TestAnimDir = TestAnimDir AnimDir++instance Arbitrary TestAnimDir where+  arbitrary :: Gen TestAnimDir+  arbitrary = TestAnimDir <$> oneof [pure AnimDirForward, pure AnimDirBackward]++type TestAnimRepeat :: Nat -> Nat -> Type+newtype TestAnimRepeat nf ni = TestAnimRepeat AnimRepeat+  deriving newtype (Show)++instance (KnownNat nf, KnownNat ni) => Arbitrary (TestAnimRepeat nf ni) where+  arbitrary :: Gen (TestAnimRepeat nf ni)+  arbitrary =+    TestAnimRepeat <$> frequency+      [ ( fromInteger $ natVal $ Proxy @nf+        , AnimRepeatCount . getNonNegative <$> arbitrary+        )+      , ( fromInteger $ natVal $ Proxy @ni+        , pure AnimRepeatForever+        )+      ]++genMkAnimBuilder :: Gen (AnimSlice_ V.Vector Rational AnimFrame -> AnimBuilder_ V.Vector Rational AnimFrame)+genMkAnimBuilder = arbitrary <&> \case+  False -> fromAnimSlice+  True -> pingpongAnimSlice++genAnimFrame :: Arbitrary a => Gen (AnimFrame_ a)+genAnimFrame = AnimFrame <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++fromSteppedAnim :: SteppedAnim_ v t f -> (AnimStatus, Anim_ v t f)+fromSteppedAnim SteppedAnim { steppedAnimStatus = as, steppedAnimValue = a } = (as, a)