{-# 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
  { forall (v :: * -> *) t f. Anim_ v t f -> t
animElapsed :: !t
  , forall (v :: * -> *) t f. Anim_ v t f -> Int
animIndex :: !Int
  , forall (v :: * -> *) t f. Anim_ v t f -> t -> t
animUpdateFrameDur :: !(t -> t)
  , forall (v :: * -> *) t f. Anim_ v t f -> AnimBuilder_ v t f
animBuilder :: !(AnimBuilder_ v t f)
  } deriving stock (Int -> Anim_ v t f -> ShowS
[Anim_ v t f] -> ShowS
Anim_ v t f -> String
(Int -> Anim_ v t f -> ShowS)
-> (Anim_ v t f -> String)
-> ([Anim_ v t f] -> ShowS)
-> Show (Anim_ v t f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Int -> Anim_ v t f -> ShowS
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
[Anim_ v t f] -> ShowS
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Anim_ v t f -> String
$cshowsPrec :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Int -> Anim_ v t f -> ShowS
showsPrec :: Int -> Anim_ v t f -> ShowS
$cshow :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Anim_ v t f -> String
show :: Anim_ v t f -> String
$cshowList :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
[Anim_ v t f] -> ShowS
showList :: [Anim_ v t f] -> ShowS
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
  { forall i. AnimFrame_ i -> i
animFrameX :: !i -- ^ X coordinate of top-left point in pixels.
  , forall i. AnimFrame_ i -> i
animFrameY :: !i -- ^ Y coordinate of top-left point in pixels.
  , forall i. AnimFrame_ i -> i
animFrameW :: !i -- ^ Width in pixels.
  , forall i. AnimFrame_ i -> i
animFrameH :: !i -- ^ Height in pixels.
  } deriving stock (AnimFrame_ i -> AnimFrame_ i -> Bool
(AnimFrame_ i -> AnimFrame_ i -> Bool)
-> (AnimFrame_ i -> AnimFrame_ i -> Bool) -> Eq (AnimFrame_ i)
forall i. Eq i => AnimFrame_ i -> AnimFrame_ i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall i. Eq i => AnimFrame_ i -> AnimFrame_ i -> Bool
== :: AnimFrame_ i -> AnimFrame_ i -> Bool
$c/= :: forall i. Eq i => AnimFrame_ i -> AnimFrame_ i -> Bool
/= :: AnimFrame_ i -> AnimFrame_ i -> Bool
Eq, Int -> AnimFrame_ i -> ShowS
[AnimFrame_ i] -> ShowS
AnimFrame_ i -> String
(Int -> AnimFrame_ i -> ShowS)
-> (AnimFrame_ i -> String)
-> ([AnimFrame_ i] -> ShowS)
-> Show (AnimFrame_ i)
forall i. Show i => Int -> AnimFrame_ i -> ShowS
forall i. Show i => [AnimFrame_ i] -> ShowS
forall i. Show i => AnimFrame_ i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall i. Show i => Int -> AnimFrame_ i -> ShowS
showsPrec :: Int -> AnimFrame_ i -> ShowS
$cshow :: forall i. Show i => AnimFrame_ i -> String
show :: AnimFrame_ i -> String
$cshowList :: forall i. Show i => [AnimFrame_ i] -> ShowS
showList :: [AnimFrame_ i] -> ShowS
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 :: forall (v :: * -> *) t f. Vector v f => Anim_ v t f -> f
animFrame Anim_ v t f
a = v f
frames v f -> Int -> f
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
G.! Int
idx
  where
  Anim { animIndex :: forall (v :: * -> *) t f. Anim_ v t f -> Int
animIndex = Int
idx, animBuilder :: forall (v :: * -> *) t f. Anim_ v t f -> AnimBuilder_ v t f
animBuilder = AnimBuilder_ v t f
ab } = Anim_ v t f
a
  AnimBuilder { animBuilderSlice :: forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice = AnimSlice_ v t f
as } = AnimBuilder_ v t f
ab
  AnimSlice { animSliceFrames :: forall (v :: * -> *) t f. AnimSlice_ v t f -> v f
animSliceFrames = v f
frames } = AnimSlice_ v t f
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 :: forall (v :: * -> *) t f. Anim_ v t f -> AnimSlice_ v t f
animSlice Anim_ v t f
a = AnimBuilder_ v t f -> AnimSlice_ v t f
forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice (AnimBuilder_ v t f -> AnimSlice_ v t f)
-> AnimBuilder_ v t f -> AnimSlice_ v t f
forall a b. (a -> b) -> a -> b
$ Anim_ v t f -> AnimBuilder_ v t f
forall (v :: * -> *) t f. Anim_ v t f -> AnimBuilder_ v t f
animBuilder Anim_ v t f
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 :: forall (v :: * -> *) t f.
Anim_ v t f -> NonEmpty (AnimSlice_ v t f)
animSequence Anim_ v t f
a = AnimSlice_ v t f
as AnimSlice_ v t f
-> [AnimSlice_ v t f] -> NonEmpty (AnimSlice_ v t f)
forall a. a -> [a] -> NonEmpty a
:| [AnimSlice_ v t f]
rest
  where
  Anim { animBuilder :: forall (v :: * -> *) t f. Anim_ v t f -> AnimBuilder_ v t f
animBuilder = AnimBuilder_ v t f
ab } = Anim_ v t f
a
  AnimBuilder { animBuilderSlice :: forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice = AnimSlice_ v t f
as, animBuilderNext :: forall (v :: * -> *) t f. AnimBuilder_ v t f -> [AnimSlice_ v t f]
animBuilderNext = [AnimSlice_ v t f]
rest } = AnimBuilder_ v t f
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 :: forall (v :: * -> *) t f. Anim_ v t f -> Maybe (AnimMeta_ t)
animMeta Anim { animBuilder :: forall (v :: * -> *) t f. Anim_ v t f -> AnimBuilder_ v t f
animBuilder = AnimBuilder_ v t f
ab }
  | Finite AnimMeta_ t
am <- AnimBuilder_ v t f -> Countable (AnimMeta_ t)
forall (v :: * -> *) t f.
AnimBuilder_ v t f -> Countable (AnimMeta_ t)
animBuilderMeta AnimBuilder_ v t f
ab = AnimMeta_ t -> Maybe (AnimMeta_ t)
forall a. a -> Maybe a
Just AnimMeta_ t
am
  | Bool
otherwise = Maybe (AnimMeta_ t)
forall a. Maybe a
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 (AnimDuration_ t -> AnimDuration_ t -> Bool
(AnimDuration_ t -> AnimDuration_ t -> Bool)
-> (AnimDuration_ t -> AnimDuration_ t -> Bool)
-> Eq (AnimDuration_ t)
forall t. Eq t => AnimDuration_ t -> AnimDuration_ t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => AnimDuration_ t -> AnimDuration_ t -> Bool
== :: AnimDuration_ t -> AnimDuration_ t -> Bool
$c/= :: forall t. Eq t => AnimDuration_ t -> AnimDuration_ t -> Bool
/= :: AnimDuration_ t -> AnimDuration_ t -> Bool
Eq, Int -> AnimDuration_ t -> ShowS
[AnimDuration_ t] -> ShowS
AnimDuration_ t -> String
(Int -> AnimDuration_ t -> ShowS)
-> (AnimDuration_ t -> String)
-> ([AnimDuration_ t] -> ShowS)
-> Show (AnimDuration_ t)
forall t. Show t => Int -> AnimDuration_ t -> ShowS
forall t. Show t => [AnimDuration_ t] -> ShowS
forall t. Show t => AnimDuration_ t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> AnimDuration_ t -> ShowS
showsPrec :: Int -> AnimDuration_ t -> ShowS
$cshow :: forall t. Show t => AnimDuration_ t -> String
show :: AnimDuration_ t -> String
$cshowList :: forall t. Show t => [AnimDuration_ t] -> ShowS
showList :: [AnimDuration_ t] -> ShowS
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 :: forall (v :: * -> *) t f.
(Vector v f, Fractional t) =>
AnimDuration_ t -> AnimBuilder_ v t f -> Anim_ v t f
buildAnim AnimDuration_ t
ad AnimBuilder_ v t f
ab =
  Anim
    { animElapsed :: t
animElapsed = t
0
    , animIndex :: Int
animIndex = AnimSlice_ v t f -> Int
forall (v :: * -> *) t f. Vector v f => AnimSlice_ v t f -> Int
startIdx (AnimSlice_ v t f -> Int) -> AnimSlice_ v t f -> Int
forall a b. (a -> b) -> a -> b
$ AnimBuilder_ v t f -> AnimSlice_ v t f
forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice AnimBuilder_ v t f
ab
    , animUpdateFrameDur :: t -> t
animUpdateFrameDur = t -> t
updateFrameDur
    , animBuilder :: AnimBuilder_ v t f
animBuilder = AnimBuilder_ v t f
ab
        { animBuilderMeta =
            case animBuilderMeta ab of
              Countable (AnimMeta_ t)
Infinite -> Countable (AnimMeta_ t)
forall a. Countable a
Infinite
              Finite AnimMeta_ t
am -> AnimMeta_ t -> Countable (AnimMeta_ t)
forall a. a -> Countable a
Finite AnimMeta
                { animMetaTotalFrameCount :: Int
animMetaTotalFrameCount = AnimMeta_ t -> Int
forall t. AnimMeta_ t -> Int
animMetaTotalFrameCount AnimMeta_ t
am
                , animMetaTotalDur :: t
animMetaTotalDur =
                    case AnimDuration_ t
ad of
                      AnimDuration_ t
AnimDurationDefault -> AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaTotalDur AnimMeta_ t
am
                      AnimDurationScaled t
scale -> t
scale t -> t -> t
forall a. Num a => a -> a -> a
* AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaTotalDur AnimMeta_ t
am
                      AnimDurationTotal t
dur -> t
dur
                      AnimDurationEachFrame t
dur -> t
dur t -> t -> t
forall a. Num a => a -> a -> a
* Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (AnimMeta_ t -> Int
forall t. AnimMeta_ t -> Int
animMetaTotalFrameCount AnimMeta_ t
am)
                      AnimDurationEachFrameFromTotal t
dur -> t
dur
                , animMetaMinFrameDur :: t
animMetaMinFrameDur = t -> t
updateFrameDur (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaMinFrameDur AnimMeta_ t
am
                , animMetaMaxFrameDur :: t
animMetaMaxFrameDur = t -> t
updateFrameDur (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaMaxFrameDur AnimMeta_ t
am
                }
        }
    }
  where
  updateFrameDur :: t -> t
updateFrameDur =
    case AnimDuration_ t
ad of
      AnimDuration_ t
AnimDurationDefault -> t -> t
forall a. a -> a
id
      AnimDurationScaled t
scale -> (t
scale *)
      AnimDurationTotal t
dur
        | Finite (AnimMeta Int
_ t
defaultDur t
_ t
_) <- AnimBuilder_ v t f -> Countable (AnimMeta_ t)
forall (v :: * -> *) t f.
AnimBuilder_ v t f -> Countable (AnimMeta_ t)
animBuilderMeta AnimBuilder_ v t f
ab ->
            ((t
dur t -> t -> t
forall a. Fractional a => a -> a -> a
/ t
defaultDur) *)
        | Bool
otherwise ->
            String -> t -> t
forall a. HasCallStack => String -> a
error (String -> t -> t) -> String -> t -> t
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
              [ String
"buildAnim: cannot override total duration of infinite"
              , String
"animation"
              ]
      AnimDurationEachFrame t
dur -> t -> t -> t
forall a b. a -> b -> a
const t
dur
      AnimDurationEachFrameFromTotal t
dur
        | Finite (AnimMeta Int
frameCount t
_ t
_ t
_) <- AnimBuilder_ v t f -> Countable (AnimMeta_ t)
forall (v :: * -> *) t f.
AnimBuilder_ v t f -> Countable (AnimMeta_ t)
animBuilderMeta AnimBuilder_ v t f
ab ->
            t -> t -> t
forall a b. a -> b -> a
const (t -> t -> t) -> t -> t -> t
forall a b. (a -> b) -> a -> b
$ t
dur t -> t -> t
forall a. Fractional a => a -> a -> a
/ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
frameCount
        | Bool
otherwise ->
            String -> t -> t
forall a. HasCallStack => String -> a
error (String -> t -> t) -> String -> t -> t
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
              [ String
"buildAnim: cannot override total duration of infinite"
              , String
"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 (AnimStatus -> AnimStatus -> Bool
(AnimStatus -> AnimStatus -> Bool)
-> (AnimStatus -> AnimStatus -> Bool) -> Eq AnimStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnimStatus -> AnimStatus -> Bool
== :: AnimStatus -> AnimStatus -> Bool
$c/= :: AnimStatus -> AnimStatus -> Bool
/= :: AnimStatus -> AnimStatus -> Bool
Eq, Int -> AnimStatus -> ShowS
[AnimStatus] -> ShowS
AnimStatus -> String
(Int -> AnimStatus -> ShowS)
-> (AnimStatus -> String)
-> ([AnimStatus] -> ShowS)
-> Show AnimStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnimStatus -> ShowS
showsPrec :: Int -> AnimStatus -> ShowS
$cshow :: AnimStatus -> String
show :: AnimStatus -> String
$cshowList :: [AnimStatus] -> ShowS
showList :: [AnimStatus] -> ShowS
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
  { forall (v :: * -> *) t f. SteppedAnim_ v t f -> AnimStatus
steppedAnimStatus :: !AnimStatus
    -- ^ Indicates if the animation has finished or is actively playing.
  , forall (v :: * -> *) t f. SteppedAnim_ v t f -> Anim_ v t f
steppedAnimValue :: !(Anim_ v t f)
    -- ^ The updated animation value.
  } deriving stock (Int -> SteppedAnim_ v t f -> ShowS
[SteppedAnim_ v t f] -> ShowS
SteppedAnim_ v t f -> String
(Int -> SteppedAnim_ v t f -> ShowS)
-> (SteppedAnim_ v t f -> String)
-> ([SteppedAnim_ v t f] -> ShowS)
-> Show (SteppedAnim_ v t f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Int -> SteppedAnim_ v t f -> ShowS
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
[SteppedAnim_ v t f] -> ShowS
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
SteppedAnim_ v t f -> String
$cshowsPrec :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Int -> SteppedAnim_ v t f -> ShowS
showsPrec :: Int -> SteppedAnim_ v t f -> ShowS
$cshow :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
SteppedAnim_ v t f -> String
show :: SteppedAnim_ v t f -> String
$cshowList :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
[SteppedAnim_ v t f] -> ShowS
showList :: [SteppedAnim_ v t f] -> ShowS
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 :: forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
t -> Anim_ v t f -> SteppedAnim_ v t f
stepAnim t
dt Anim_ v t f
a
  | t
elapsed' t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
timer =
      if t
dt t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 then
        SteppedAnim
          { steppedAnimStatus :: AnimStatus
steppedAnimStatus = AnimStatus
AnimStatusPlaying
          , steppedAnimValue :: Anim_ v t f
steppedAnimValue = Anim_ v t f
a
          }
      else
        t -> Anim_ v t f -> SteppedAnim_ v t f
forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
t -> Anim_ v t f -> SteppedAnim_ v t f
stepAnim t
0 Anim_ v t f
a { animElapsed = elapsed' }
  | Bool
otherwise =
      if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endIdx then
        case [AnimSlice_ v t f]
s of
          [] ->
            SteppedAnim
              { steppedAnimStatus :: AnimStatus
steppedAnimStatus = AnimStatus
AnimStatusFinished
              , steppedAnimValue :: Anim_ v t f
steppedAnimValue = Anim_ v t f
a
              }
          AnimSlice_ v t f
next : [AnimSlice_ v t f]
rest ->
            t -> Anim_ v t f -> SteppedAnim_ v t f
forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
t -> Anim_ v t f -> SteppedAnim_ v t f
stepAnim (t
elapsed' t -> t -> t
forall a. Num a => a -> a -> a
- t
timer) Anim_ v t f
a
              { animElapsed = 0
              , animIndex = startIdx next
              , animBuilder =
                  AnimBuilder
                    { animBuilderMeta = am
                    , animBuilderSlice = next
                    , animBuilderNext = rest
                    }
              }
      else
        t -> Anim_ v t f -> SteppedAnim_ v t f
forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
t -> Anim_ v t f -> SteppedAnim_ v t f
stepAnim (t
elapsed' t -> t -> t
forall a. Num a => a -> a -> a
- t
timer) Anim_ v t f
a
          { animElapsed = 0
          , animIndex = idx + idxStep
          }
  where
  elapsed', timer :: t
  elapsed' :: t
elapsed' = t
elapsed t -> t -> t
forall a. Num a => a -> a -> a
+ t
dt
  timer :: t
timer = t -> t
updateFrameDur (t -> t) -> t -> t
forall a b. (a -> b) -> a -> b
$ v t
frameDurs v t -> Int -> t
forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
G.! Int
idx

  idxStep, endIdx :: Int
  (Int
idxStep, Int
endIdx) =
    case AnimDir
dir of
      AnimDir
AnimDirForward -> (Int
1, v f -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v f
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      AnimDir
AnimDirBackward -> (-Int
1, Int
0)

  Anim
    { animElapsed :: forall (v :: * -> *) t f. Anim_ v t f -> t
animElapsed = t
elapsed
    , animIndex :: forall (v :: * -> *) t f. Anim_ v t f -> Int
animIndex = Int
idx
    , animUpdateFrameDur :: forall (v :: * -> *) t f. Anim_ v t f -> t -> t
animUpdateFrameDur = t -> t
updateFrameDur
    , animBuilder :: forall (v :: * -> *) t f. Anim_ v t f -> AnimBuilder_ v t f
animBuilder = AnimBuilder_ v t f
ab
    } = Anim_ v t f
a

  AnimBuilder
    { animBuilderMeta :: forall (v :: * -> *) t f.
AnimBuilder_ v t f -> Countable (AnimMeta_ t)
animBuilderMeta = Countable (AnimMeta_ t)
am
    , animBuilderSlice :: forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice = AnimSlice_ v t f
as
    , animBuilderNext :: forall (v :: * -> *) t f. AnimBuilder_ v t f -> [AnimSlice_ v t f]
animBuilderNext = [AnimSlice_ v t f]
s
    } = AnimBuilder_ v t f
ab

  AnimSlice
    { animSliceDir :: forall (v :: * -> *) t f. AnimSlice_ v t f -> AnimDir
animSliceDir = AnimDir
dir
    , animSliceFrameDurs :: forall (v :: * -> *) t f. AnimSlice_ v t f -> v t
animSliceFrameDurs = v t
frameDurs
    , animSliceFrames :: forall (v :: * -> *) t f. AnimSlice_ v t f -> v f
animSliceFrames = v f
frames
    } = AnimSlice_ v t f
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 :: forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
t -> Anim_ v t f -> [SteppedAnim_ v t f]
iterateAnim t
dt Anim_ v t f
a0 =
  [SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
forall (v :: * -> *) t f.
[SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
takeUntilDone ([SteppedAnim_ v t f] -> [SteppedAnim_ v t f])
-> [SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
forall a b. (a -> b) -> a -> b
$ (SteppedAnim_ v t f -> SteppedAnim_ v t f)
-> SteppedAnim_ v t f -> [SteppedAnim_ v t f]
forall a. (a -> a) -> a -> [a]
L.iterate (t -> Anim_ v t f -> SteppedAnim_ v t f
forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
t -> Anim_ v t f -> SteppedAnim_ v t f
stepAnim t
dt (Anim_ v t f -> SteppedAnim_ v t f)
-> (SteppedAnim_ v t f -> Anim_ v t f)
-> SteppedAnim_ v t f
-> SteppedAnim_ v t f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SteppedAnim_ v t f -> Anim_ v t f
forall (v :: * -> *) t f. SteppedAnim_ v t f -> Anim_ v t f
steppedAnimValue) (SteppedAnim_ v t f -> [SteppedAnim_ v t f])
-> SteppedAnim_ v t f -> [SteppedAnim_ v t f]
forall a b. (a -> b) -> a -> b
$ t -> Anim_ v t f -> SteppedAnim_ v t f
forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
t -> Anim_ v t f -> SteppedAnim_ v t f
stepAnim t
dt Anim_ v t f
a0

takeUntilDone :: forall v t f. [SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
takeUntilDone :: forall (v :: * -> *) t f.
[SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
takeUntilDone = \case
  [] -> []
  SteppedAnim_ v t f
sa : [SteppedAnim_ v t f]
rest
    | AnimStatus
AnimStatusPlaying <- SteppedAnim_ v t f -> AnimStatus
forall (v :: * -> *) t f. SteppedAnim_ v t f -> AnimStatus
steppedAnimStatus SteppedAnim_ v t f
sa ->
        SteppedAnim_ v t f
sa SteppedAnim_ v t f -> [SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
forall a. a -> [a] -> [a]
: [SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
forall (v :: * -> *) t f.
[SteppedAnim_ v t f] -> [SteppedAnim_ v t f]
takeUntilDone [SteppedAnim_ v t f]
rest
    | Bool
otherwise ->
        [SteppedAnim_ v t f
sa]

startIdx :: forall v t f. G.Vector v f => AnimSlice_ v t f -> Int
startIdx :: forall (v :: * -> *) t f. Vector v f => AnimSlice_ v t f -> Int
startIdx AnimSlice_ v t f
as =
  case AnimSlice_ v t f -> AnimDir
forall (v :: * -> *) t f. AnimSlice_ v t f -> AnimDir
animSliceDir AnimSlice_ v t f
as of
    AnimDir
AnimDirForward -> Int
0
    AnimDir
AnimDirBackward -> v f -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length (AnimSlice_ v t f -> v f
forall (v :: * -> *) t f. AnimSlice_ v t f -> v f
animSliceFrames AnimSlice_ v t f
as) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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
  { forall (v :: * -> *) t f.
AnimBuilder_ v t f -> Countable (AnimMeta_ t)
animBuilderMeta :: !(Countable (AnimMeta_ t))
  , forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice :: !(AnimSlice_ v t f)
  , forall (v :: * -> *) t f. AnimBuilder_ v t f -> [AnimSlice_ v t f]
animBuilderNext :: ![AnimSlice_ v t f]
  } deriving stock (AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool
(AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool)
-> (AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool)
-> Eq (AnimBuilder_ v t f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) t f.
(Eq t, Eq (v t), Eq (v f)) =>
AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool
$c== :: forall (v :: * -> *) t f.
(Eq t, Eq (v t), Eq (v f)) =>
AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool
== :: AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool
$c/= :: forall (v :: * -> *) t f.
(Eq t, Eq (v t), Eq (v f)) =>
AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool
/= :: AnimBuilder_ v t f -> AnimBuilder_ v t f -> Bool
Eq, Int -> AnimBuilder_ v t f -> ShowS
[AnimBuilder_ v t f] -> ShowS
AnimBuilder_ v t f -> String
(Int -> AnimBuilder_ v t f -> ShowS)
-> (AnimBuilder_ v t f -> String)
-> ([AnimBuilder_ v t f] -> ShowS)
-> Show (AnimBuilder_ v t f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Int -> AnimBuilder_ v t f -> ShowS
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
[AnimBuilder_ v t f] -> ShowS
forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
AnimBuilder_ v t f -> String
$cshowsPrec :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
Int -> AnimBuilder_ v t f -> ShowS
showsPrec :: Int -> AnimBuilder_ v t f -> ShowS
$cshow :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
AnimBuilder_ v t f -> String
show :: AnimBuilder_ v t f -> String
$cshowList :: forall (v :: * -> *) t f.
(Show t, Show (v t), Show (v f)) =>
[AnimBuilder_ v t f] -> ShowS
showList :: [AnimBuilder_ v t f] -> ShowS
Show)

instance RealFrac t => Semigroup (AnimBuilder_ v t f) where
  (<>) :: AnimBuilder_ v t f -> AnimBuilder_ v t f -> AnimBuilder_ v t f
  AnimBuilder_ v t f
x <> :: AnimBuilder_ v t f -> AnimBuilder_ v t f -> AnimBuilder_ v t f
<> AnimBuilder_ v t f
y =
    AnimBuilder
      { animBuilderMeta :: Countable (AnimMeta_ t)
animBuilderMeta =
          AnimBuilder_ v t f -> Countable (AnimMeta_ t)
forall (v :: * -> *) t f.
AnimBuilder_ v t f -> Countable (AnimMeta_ t)
animBuilderMeta AnimBuilder_ v t f
x Countable (AnimMeta_ t)
-> Countable (AnimMeta_ t) -> Countable (AnimMeta_ t)
forall a. Semigroup a => a -> a -> a
<> AnimBuilder_ v t f -> Countable (AnimMeta_ t)
forall (v :: * -> *) t f.
AnimBuilder_ v t f -> Countable (AnimMeta_ t)
animBuilderMeta AnimBuilder_ v t f
y
      , animBuilderSlice :: AnimSlice_ v t f
animBuilderSlice = AnimBuilder_ v t f -> AnimSlice_ v t f
forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice AnimBuilder_ v t f
x
      , animBuilderNext :: [AnimSlice_ v t f]
animBuilderNext =
          AnimBuilder_ v t f -> [AnimSlice_ v t f]
forall (v :: * -> *) t f. AnimBuilder_ v t f -> [AnimSlice_ v t f]
animBuilderNext AnimBuilder_ v t f
x [AnimSlice_ v t f] -> [AnimSlice_ v t f] -> [AnimSlice_ v t f]
forall a. [a] -> [a] -> [a]
++ (AnimBuilder_ v t f -> AnimSlice_ v t f
forall (v :: * -> *) t f. AnimBuilder_ v t f -> AnimSlice_ v t f
animBuilderSlice AnimBuilder_ v t f
y AnimSlice_ v t f -> [AnimSlice_ v t f] -> [AnimSlice_ v t f]
forall a. a -> [a] -> [a]
: AnimBuilder_ v t f -> [AnimSlice_ v t f]
forall (v :: * -> *) t f. AnimBuilder_ v t f -> [AnimSlice_ v t f]
animBuilderNext AnimBuilder_ v t f
y)
      }

  stimes :: Integral b => b -> AnimBuilder_ v t f -> AnimBuilder_ v t f
  stimes :: forall b.
Integral b =>
b -> AnimBuilder_ v t f -> AnimBuilder_ v t f
stimes b
n AnimBuilder_ v t f
x
    | b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 = String -> AnimBuilder_ v t f
forall a. HasCallStack => String -> a
error String
"AnimBuilder_.stimes: positive multiplier expected"
    | Bool
otherwise = b -> AnimBuilder_ v t f
go b
n
    where
    go :: b -> AnimBuilder_ v t f
go = \case
      b
1 -> AnimBuilder_ v t f
x
      b
i -> AnimBuilder_ v t f
x AnimBuilder_ v t f -> AnimBuilder_ v t f -> AnimBuilder_ v t f
forall a. Semigroup a => a -> a -> a
<> b -> AnimBuilder_ v t f
go (b
i b -> b -> b
forall a. Num a => a -> a -> a
- b
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 :: forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
AnimSlice_ v t f -> AnimBuilder_ v t f
fromAnimSlice AnimSlice_ v t f
as
  | Int
frameDursLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
framesLen =
      let errMsg :: String
errMsg = [String] -> String
unwords
            [ String
"fromAnimSlice: mismatch between frame duration vector size (%d)"
            , String
"and source rectangle vector size (%d)"
            ]
       in String -> AnimBuilder_ v t f
forall a. HasCallStack => String -> a
error (String -> AnimBuilder_ v t f) -> String -> AnimBuilder_ v t f
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
errMsg Int
frameDursLen Int
framesLen
  | Int
frameDursLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 =
      String -> AnimBuilder_ v t f
forall a. HasCallStack => String -> a
error String
"fromAnimSlice: empty frame duration and source rectangle vectors"
  | Bool
otherwise =
      AnimBuilder
        { animBuilderMeta :: Countable (AnimMeta_ t)
animBuilderMeta =
            AnimMeta_ t -> Countable (AnimMeta_ t)
forall a. a -> Countable a
Finite AnimMeta
              { animMetaTotalFrameCount :: Int
animMetaTotalFrameCount = Int
framesLen
              , animMetaTotalDur :: t
animMetaTotalDur = v t -> t
forall (v :: * -> *) a. (Vector v a, Num a) => v a -> a
G.sum v t
frameDurs
              , animMetaMinFrameDur :: t
animMetaMinFrameDur = v t -> t
forall (v :: * -> *) a. (Vector v a, Ord a) => v a -> a
G.minimum v t
frameDurs
              , animMetaMaxFrameDur :: t
animMetaMaxFrameDur = v t -> t
forall (v :: * -> *) a. (Vector v a, Ord a) => v a -> a
G.maximum v t
frameDurs
              }
        , animBuilderSlice :: AnimSlice_ v t f
animBuilderSlice = AnimSlice_ v t f
as
        , animBuilderNext :: [AnimSlice_ v t f]
animBuilderNext = []
        }
  where
  frameDursLen, framesLen :: Int
  frameDursLen :: Int
frameDursLen = v t -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v t
frameDurs
  framesLen :: Int
framesLen = v f -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v f
frames

  AnimSlice
    { animSliceFrameDurs :: forall (v :: * -> *) t f. AnimSlice_ v t f -> v t
animSliceFrameDurs = v t
frameDurs
    , animSliceFrames :: forall (v :: * -> *) t f. AnimSlice_ v t f -> v f
animSliceFrames = v f
frames
    } = AnimSlice_ v t f
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 :: forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
AnimSlice_ v t f -> AnimBuilder_ v t f
pingpongAnimSlice AnimSlice_ v t f
as = AnimBuilder_ v t f
ab AnimBuilder_ v t f -> AnimBuilder_ v t f -> AnimBuilder_ v t f
forall a. Semigroup a => a -> a -> a
<> AnimBuilder_ v t f
ab'
  where
  ab :: AnimBuilder_ v t f
ab = AnimSlice_ v t f -> AnimBuilder_ v t f
forall (v :: * -> *) t f.
(Vector v t, Vector v f, RealFrac t) =>
AnimSlice_ v t f -> AnimBuilder_ v t f
fromAnimSlice AnimSlice_ v t f
as
  ab' :: AnimBuilder_ v t f
ab' = AnimBuilder_ v t f
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 :: forall (v :: * -> *) t f.
RealFrac t =>
AnimRepeat -> AnimBuilder_ v t f -> AnimBuilder_ v t f
repeatAnim AnimRepeat
ar AnimBuilder_ v t f
ab =
  case AnimRepeat
ar of
    AnimRepeat
AnimRepeatForever ->
      let ab' :: AnimBuilder_ v t f
ab' = AnimBuilder_ v t f
ab { animBuilderMeta = Infinite } AnimBuilder_ v t f -> AnimBuilder_ v t f -> AnimBuilder_ v t f
forall a. Semigroup a => a -> a -> a
<> AnimBuilder_ v t f
ab' in AnimBuilder_ v t f
ab'
    AnimRepeatCount Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> AnimBuilder_ v t f
ab
      | Bool
otherwise -> Int -> AnimBuilder_ v t f -> AnimBuilder_ v t f
forall b.
Integral b =>
b -> AnimBuilder_ v t f -> AnimBuilder_ v t f
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) AnimBuilder_ v t f
ab

-- | Animation metadata.
type AnimMeta :: Type
type AnimMeta = AnimMeta_ Double

type AnimMeta_ :: Type -> Type
data AnimMeta_ t = AnimMeta
  { forall t. AnimMeta_ t -> Int
animMetaTotalFrameCount :: !Int
  , forall t. AnimMeta_ t -> t
animMetaTotalDur :: !t
  , forall t. AnimMeta_ t -> t
animMetaMinFrameDur :: !t
  , forall t. AnimMeta_ t -> t
animMetaMaxFrameDur :: !t
  } deriving stock (AnimMeta_ t -> AnimMeta_ t -> Bool
(AnimMeta_ t -> AnimMeta_ t -> Bool)
-> (AnimMeta_ t -> AnimMeta_ t -> Bool) -> Eq (AnimMeta_ t)
forall t. Eq t => AnimMeta_ t -> AnimMeta_ t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => AnimMeta_ t -> AnimMeta_ t -> Bool
== :: AnimMeta_ t -> AnimMeta_ t -> Bool
$c/= :: forall t. Eq t => AnimMeta_ t -> AnimMeta_ t -> Bool
/= :: AnimMeta_ t -> AnimMeta_ t -> Bool
Eq, Int -> AnimMeta_ t -> ShowS
[AnimMeta_ t] -> ShowS
AnimMeta_ t -> String
(Int -> AnimMeta_ t -> ShowS)
-> (AnimMeta_ t -> String)
-> ([AnimMeta_ t] -> ShowS)
-> Show (AnimMeta_ t)
forall t. Show t => Int -> AnimMeta_ t -> ShowS
forall t. Show t => [AnimMeta_ t] -> ShowS
forall t. Show t => AnimMeta_ t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> AnimMeta_ t -> ShowS
showsPrec :: Int -> AnimMeta_ t -> ShowS
$cshow :: forall t. Show t => AnimMeta_ t -> String
show :: AnimMeta_ t -> String
$cshowList :: forall t. Show t => [AnimMeta_ t] -> ShowS
showList :: [AnimMeta_ t] -> ShowS
Show)

instance RealFrac t => Semigroup (AnimMeta_ t) where
  (<>) :: AnimMeta_ t -> AnimMeta_ t -> AnimMeta_ t
  AnimMeta_ t
x <> :: AnimMeta_ t -> AnimMeta_ t -> AnimMeta_ t
<> AnimMeta_ t
y =
    AnimMeta
      { animMetaTotalFrameCount :: Int
animMetaTotalFrameCount =
          AnimMeta_ t -> Int
forall t. AnimMeta_ t -> Int
animMetaTotalFrameCount AnimMeta_ t
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AnimMeta_ t -> Int
forall t. AnimMeta_ t -> Int
animMetaTotalFrameCount AnimMeta_ t
y
      , animMetaTotalDur :: t
animMetaTotalDur = AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaTotalDur AnimMeta_ t
x t -> t -> t
forall a. Num a => a -> a -> a
+ AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaTotalDur AnimMeta_ t
y
      , animMetaMinFrameDur :: t
animMetaMinFrameDur =
          t -> t -> t
forall a. Ord a => a -> a -> a
min (AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaMinFrameDur AnimMeta_ t
x) (AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaMinFrameDur AnimMeta_ t
y)
      , animMetaMaxFrameDur :: t
animMetaMaxFrameDur =
          t -> t -> t
forall a. Ord a => a -> a -> a
max (AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaMaxFrameDur AnimMeta_ t
x) (AnimMeta_ t -> t
forall t. AnimMeta_ t -> t
animMetaMaxFrameDur AnimMeta_ t
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
  { forall (v :: * -> *) t f. AnimSlice_ v t f -> AnimDir
animSliceDir :: !AnimDir
  , forall (v :: * -> *) t f. AnimSlice_ v t f -> v t
animSliceFrameDurs :: !(v t)
  , forall (v :: * -> *) t f. AnimSlice_ v t f -> v f
animSliceFrames :: !(v f)
  } deriving stock (AnimSlice_ v t f -> AnimSlice_ v t f -> Bool
(AnimSlice_ v t f -> AnimSlice_ v t f -> Bool)
-> (AnimSlice_ v t f -> AnimSlice_ v t f -> Bool)
-> Eq (AnimSlice_ v t f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) t f.
(Eq (v t), Eq (v f)) =>
AnimSlice_ v t f -> AnimSlice_ v t f -> Bool
$c== :: forall (v :: * -> *) t f.
(Eq (v t), Eq (v f)) =>
AnimSlice_ v t f -> AnimSlice_ v t f -> Bool
== :: AnimSlice_ v t f -> AnimSlice_ v t f -> Bool
$c/= :: forall (v :: * -> *) t f.
(Eq (v t), Eq (v f)) =>
AnimSlice_ v t f -> AnimSlice_ v t f -> Bool
/= :: AnimSlice_ v t f -> AnimSlice_ v t f -> Bool
Eq, Int -> AnimSlice_ v t f -> ShowS
[AnimSlice_ v t f] -> ShowS
AnimSlice_ v t f -> String
(Int -> AnimSlice_ v t f -> ShowS)
-> (AnimSlice_ v t f -> String)
-> ([AnimSlice_ v t f] -> ShowS)
-> Show (AnimSlice_ v t f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) t f.
(Show (v t), Show (v f)) =>
Int -> AnimSlice_ v t f -> ShowS
forall (v :: * -> *) t f.
(Show (v t), Show (v f)) =>
[AnimSlice_ v t f] -> ShowS
forall (v :: * -> *) t f.
(Show (v t), Show (v f)) =>
AnimSlice_ v t f -> String
$cshowsPrec :: forall (v :: * -> *) t f.
(Show (v t), Show (v f)) =>
Int -> AnimSlice_ v t f -> ShowS
showsPrec :: Int -> AnimSlice_ v t f -> ShowS
$cshow :: forall (v :: * -> *) t f.
(Show (v t), Show (v f)) =>
AnimSlice_ v t f -> String
show :: AnimSlice_ v t f -> String
$cshowList :: forall (v :: * -> *) t f.
(Show (v t), Show (v f)) =>
[AnimSlice_ v t f] -> ShowS
showList :: [AnimSlice_ v t f] -> ShowS
Show)

reverseAnimSlice :: forall v t f. AnimSlice_ v t f -> AnimSlice_ v t f
reverseAnimSlice :: forall (v :: * -> *) t f. AnimSlice_ v t f -> AnimSlice_ v t f
reverseAnimSlice AnimSlice_ v t f
as = AnimSlice_ v t f
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 (AnimDir -> AnimDir -> Bool
(AnimDir -> AnimDir -> Bool)
-> (AnimDir -> AnimDir -> Bool) -> Eq AnimDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnimDir -> AnimDir -> Bool
== :: AnimDir -> AnimDir -> Bool
$c/= :: AnimDir -> AnimDir -> Bool
/= :: AnimDir -> AnimDir -> Bool
Eq, Int -> AnimDir -> ShowS
[AnimDir] -> ShowS
AnimDir -> String
(Int -> AnimDir -> ShowS)
-> (AnimDir -> String) -> ([AnimDir] -> ShowS) -> Show AnimDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnimDir -> ShowS
showsPrec :: Int -> AnimDir -> ShowS
$cshow :: AnimDir -> String
show :: AnimDir -> String
$cshowList :: [AnimDir] -> ShowS
showList :: [AnimDir] -> ShowS
Show)

reverseAnimDir :: AnimDir -> AnimDir
reverseAnimDir :: AnimDir -> AnimDir
reverseAnimDir = \case
  AnimDir
AnimDirForward -> AnimDir
AnimDirBackward
  AnimDir
AnimDirBackward -> AnimDir
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 (Int -> AnimRepeat -> ShowS
[AnimRepeat] -> ShowS
AnimRepeat -> String
(Int -> AnimRepeat -> ShowS)
-> (AnimRepeat -> String)
-> ([AnimRepeat] -> ShowS)
-> Show AnimRepeat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnimRepeat -> ShowS
showsPrec :: Int -> AnimRepeat -> ShowS
$cshow :: AnimRepeat -> String
show :: AnimRepeat -> String
$cshowList :: [AnimRepeat] -> ShowS
showList :: [AnimRepeat] -> ShowS
Show)

type Countable :: Type -> Type
data Countable a
  = Infinite
  | Finite !a
  deriving stock (Countable a -> Countable a -> Bool
(Countable a -> Countable a -> Bool)
-> (Countable a -> Countable a -> Bool) -> Eq (Countable a)
forall a. Eq a => Countable a -> Countable a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Countable a -> Countable a -> Bool
== :: Countable a -> Countable a -> Bool
$c/= :: forall a. Eq a => Countable a -> Countable a -> Bool
/= :: Countable a -> Countable a -> Bool
Eq, Int -> Countable a -> ShowS
[Countable a] -> ShowS
Countable a -> String
(Int -> Countable a -> ShowS)
-> (Countable a -> String)
-> ([Countable a] -> ShowS)
-> Show (Countable a)
forall a. Show a => Int -> Countable a -> ShowS
forall a. Show a => [Countable a] -> ShowS
forall a. Show a => Countable a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Countable a -> ShowS
showsPrec :: Int -> Countable a -> ShowS
$cshow :: forall a. Show a => Countable a -> String
show :: Countable a -> String
$cshowList :: forall a. Show a => [Countable a] -> ShowS
showList :: [Countable a] -> ShowS
Show)

instance (Semigroup a) => Semigroup (Countable a) where
  (<>) :: Countable a -> Countable a -> Countable a
  Finite a
x <> :: Countable a -> Countable a -> Countable a
<> Finite a
y = a -> Countable a
forall a. a -> Countable a
Finite (a -> Countable a) -> a -> Countable a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y
  Countable a
_ <> Countable a
_ = Countable a
forall a. Countable a
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 :: forall s. MVector s (AnimFrame_ a) -> Int
basicLength (MV_AnimFrame Int
n MVector s a
_) = Int
n

  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice
    :: Int
    -> Int
    -> U.MVector s (AnimFrame_ a)
    -> U.MVector s (AnimFrame_ a)
  basicUnsafeSlice :: forall s.
Int -> Int -> MVector s (AnimFrame_ a) -> MVector s (AnimFrame_ a)
basicUnsafeSlice Int
m Int
n (MV_AnimFrame Int
_ MVector s a
rects) =
    Int -> MVector s a -> MVector s (AnimFrame_ a)
forall s a. Int -> MVector s a -> MVector s (AnimFrame_ a)
MV_AnimFrame Int
n (Int -> Int -> MVector s a -> MVector s a
forall s. Int -> Int -> MVector s a -> MVector s a
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GMB.basicUnsafeSlice (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m) (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) MVector s a
rects)

  {-# INLINE basicOverlaps #-}
  basicOverlaps
    :: U.MVector s (AnimFrame_ a)
    -> U.MVector s (AnimFrame_ a)
    -> Bool
  basicOverlaps :: forall s.
MVector s (AnimFrame_ a) -> MVector s (AnimFrame_ a) -> Bool
basicOverlaps (MV_AnimFrame Int
_ MVector s a
rects1) (MV_AnimFrame Int
_ MVector s a
rects2) =
    MVector s a -> MVector s a -> Bool
forall s. MVector s a -> MVector s a -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GMB.basicOverlaps MVector s a
rects1 MVector s a
rects2

  {-# INLINE basicUnsafeNew #-}
  basicUnsafeNew :: Int -> ST s (U.MVector s (AnimFrame_ a))
  basicUnsafeNew :: forall s. Int -> ST s (MVector s (AnimFrame_ a))
basicUnsafeNew Int
n = Int -> MVector s a -> MVector s (AnimFrame_ a)
forall s a. Int -> MVector s a -> MVector s (AnimFrame_ a)
MV_AnimFrame Int
n (MVector s a -> MVector s (AnimFrame_ a))
-> ST s (MVector s a) -> ST s (MVector s (AnimFrame_ a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s a)
forall s. Int -> ST s (MVector s a)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
GMB.basicUnsafeNew (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)

  {-# INLINE basicUnsafeRead #-}
  basicUnsafeRead
    :: U.MVector s (AnimFrame_ a)
    -> Int
    -> ST s (AnimFrame_ a)
  basicUnsafeRead :: forall s. MVector s (AnimFrame_ a) -> Int -> ST s (AnimFrame_ a)
basicUnsafeRead (MV_AnimFrame Int
_ MVector s a
rects) Int
i =
    a -> a -> a -> a -> AnimFrame_ a
forall i. i -> i -> i -> i -> AnimFrame_ i
AnimFrame
      (a -> a -> a -> a -> AnimFrame_ a)
-> ST s a -> ST s (a -> a -> a -> AnimFrame_ a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GMB.basicUnsafeRead MVector s a
rects Int
offset
      ST s (a -> a -> a -> AnimFrame_ a)
-> ST s a -> ST s (a -> a -> AnimFrame_ a)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GMB.basicUnsafeRead MVector s a
rects (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
      ST s (a -> a -> AnimFrame_ a) -> ST s a -> ST s (a -> AnimFrame_ a)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GMB.basicUnsafeRead MVector s a
rects (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
      ST s (a -> AnimFrame_ a) -> ST s a -> ST s (AnimFrame_ a)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVector s a -> Int -> ST s a
forall s. MVector s a -> Int -> ST s a
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GMB.basicUnsafeRead MVector s a
rects (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
    where
    offset :: Int
offset = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i

  {-# INLINE basicUnsafeWrite #-}
  basicUnsafeWrite
    :: U.MVector s (AnimFrame_ a)
    -> Int
    -> AnimFrame_ a
    -> ST s ()
  basicUnsafeWrite :: forall s.
MVector s (AnimFrame_ a) -> Int -> AnimFrame_ a -> ST s ()
basicUnsafeWrite (MV_AnimFrame Int
_ MVector s a
rects) Int
i AnimFrame_ a
x = do
    MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GMB.basicUnsafeWrite MVector s a
rects Int
offset a
animFrameX
    MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GMB.basicUnsafeWrite MVector s a
rects (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) a
animFrameY
    MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GMB.basicUnsafeWrite MVector s a
rects (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) a
animFrameW
    MVector s a -> Int -> a -> ST s ()
forall s. MVector s a -> Int -> a -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GMB.basicUnsafeWrite MVector s a
rects (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) a
animFrameH
    where
    offset :: Int
offset = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i
    AnimFrame
      { a
animFrameX :: forall i. AnimFrame_ i -> i
animFrameX :: a
animFrameX
      , a
animFrameY :: forall i. AnimFrame_ i -> i
animFrameY :: a
animFrameY
      , a
animFrameW :: forall i. AnimFrame_ i -> i
animFrameW :: a
animFrameW
      , a
animFrameH :: forall i. AnimFrame_ i -> i
animFrameH :: a
animFrameH
      } = AnimFrame_ a
x

  {-# INLINE basicInitialize #-}
  basicInitialize :: U.MVector s (AnimFrame_ a) -> ST s ()
  basicInitialize :: forall s. MVector s (AnimFrame_ a) -> ST s ()
basicInitialize (MV_AnimFrame Int
_ MVector s a
rects) = MVector s a -> ST s ()
forall s. MVector s a -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GMB.basicInitialize MVector s a
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 :: forall s.
Mutable Vector s (AnimFrame_ a) -> ST s (Vector (AnimFrame_ a))
basicUnsafeFreeze (MV_AnimFrame Int
n MVector s a
rects) =
    Int -> Vector a -> Vector (AnimFrame_ a)
forall a. Int -> Vector a -> Vector (AnimFrame_ a)
V_AnimFrame Int
n (Vector a -> Vector (AnimFrame_ a))
-> ST s (Vector a) -> ST s (Vector (AnimFrame_ a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s a -> ST s (Vector a)
forall s. Mutable Vector s a -> ST s (Vector a)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze Mutable Vector s a
MVector s a
rects

  {-# INLINE basicUnsafeThaw #-}
  basicUnsafeThaw
    :: U.Vector (AnimFrame_ a)
    -> ST s (G.Mutable U.Vector s (AnimFrame_ a))
  basicUnsafeThaw :: forall s.
Vector (AnimFrame_ a) -> ST s (Mutable Vector s (AnimFrame_ a))
basicUnsafeThaw (V_AnimFrame Int
n Vector a
rects) =
    Int -> MVector s a -> MVector s (AnimFrame_ a)
forall s a. Int -> MVector s a -> MVector s (AnimFrame_ a)
MV_AnimFrame Int
n (MVector s a -> MVector s (AnimFrame_ a))
-> ST s (MVector s a) -> ST s (MVector s (AnimFrame_ a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> ST s (Mutable Vector s a)
forall s. Vector a -> ST s (Mutable Vector s a)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector a
rects

  {-# INLINE basicLength #-}
  basicLength :: U.Vector (AnimFrame_ a) -> Int
  basicLength :: Vector (AnimFrame_ a) -> Int
basicLength (V_AnimFrame Int
n Vector a
_) = Int
n

  {-# INLINE basicUnsafeSlice #-}
  basicUnsafeSlice
    :: Int
    -> Int
    -> U.Vector (AnimFrame_ a)
    -> U.Vector (AnimFrame_ a)
  basicUnsafeSlice :: Int -> Int -> Vector (AnimFrame_ a) -> Vector (AnimFrame_ a)
basicUnsafeSlice Int
m Int
n (V_AnimFrame Int
_ Vector a
rects) =
    Int -> Vector a -> Vector (AnimFrame_ a)
forall a. Int -> Vector a -> Vector (AnimFrame_ a)
V_AnimFrame Int
n (Vector a -> Vector (AnimFrame_ a))
-> Vector a -> Vector (AnimFrame_ a)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m) (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Vector a
rects

  {-# INLINE basicUnsafeIndexM #-}
  basicUnsafeIndexM :: U.Vector (AnimFrame_ a) -> Int -> Box (AnimFrame_ a)
  basicUnsafeIndexM :: Vector (AnimFrame_ a) -> Int -> Box (AnimFrame_ a)
basicUnsafeIndexM (V_AnimFrame Int
_ Vector a
rects) Int
i =
    a -> a -> a -> a -> AnimFrame_ a
forall i. i -> i -> i -> i -> AnimFrame_ i
AnimFrame
      (a -> a -> a -> a -> AnimFrame_ a)
-> Box a -> Box (a -> a -> a -> AnimFrame_ a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
rects Int
offset
      Box (a -> a -> a -> AnimFrame_ a)
-> Box a -> Box (a -> a -> AnimFrame_ a)
forall a b. Box (a -> b) -> Box a -> Box b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
rects (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
      Box (a -> a -> AnimFrame_ a) -> Box a -> Box (a -> AnimFrame_ a)
forall a b. Box (a -> b) -> Box a -> Box b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
rects (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
      Box (a -> AnimFrame_ a) -> Box a -> Box (AnimFrame_ a)
forall a b. Box (a -> b) -> Box a -> Box b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vector a -> Int -> Box a
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector a
rects (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset)
    where
    offset :: Int
offset = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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.
-}