{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.Animation
  ( Animator (..),
    AnimatorTag (..),
    AnimationPlugin,
    input,
    inputIfNeq,
    shift,
    Animation,
    Animations (..),
    selAnim,
    Spritesheet,
    noAnimation,
  )
where

import Control.Monad
import Data.Data
import GHC.Float (int2Float)
import Mischief.Animation.Animations (Animations (..), selAnim)
import Mischief.Animation.Animator
import Mischief.Animation.Spritesheet
import Mischief.Assets
import Mischief.ECS
import Mischief.ECS.Time qualified as Time
import Mischief.Render.Sprite.Common

data Animator where
  Animator :: forall a. (AnimatorTag a) => a -> Animator

instance Component Animator where
  onSet :: [Hook Animator]
onSet =
    [ (HookContext -> System ()) -> Hook Animator
forall {k} (a :: k). (HookContext -> System ()) -> Hook a
hook ((HookContext -> System ()) -> Hook Animator)
-> (HookContext -> System ()) -> Hook Animator
forall a b. (a -> b) -> a -> b
$ \HookContext {Entity
entity :: Entity
entity :: HookContext -> Entity
entity} -> do
        Just (Animator (_ :: a)) <- Query System Animator -> System (Maybe Animator)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single [q|entity. Animator|]
        insert (AnimatorInput (defInput @a)) entity
    ]

data AnimatorInput where
  AnimatorInput :: (Typeable a) => a -> AnimatorInput
  deriving (Typeable AnimatorInput
[HookRel AnimatorInput]
[Hook AnimatorInput]
Set DefaultComponentType
IsExclusive (IsExclusiveRel AnimatorInput)
(Typeable AnimatorInput,
 IsExclusive (IsExclusiveRel AnimatorInput)) =>
Set DefaultComponentType
-> [Hook AnimatorInput]
-> [Hook AnimatorInput]
-> [Hook AnimatorInput]
-> [HookRel AnimatorInput]
-> [HookRel AnimatorInput]
-> [HookRel AnimatorInput]
-> Component AnimatorInput
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook AnimatorInput]
onAdd :: [Hook AnimatorInput]
$conSet :: [Hook AnimatorInput]
onSet :: [Hook AnimatorInput]
$conRemove :: [Hook AnimatorInput]
onRemove :: [Hook AnimatorInput]
$conAddRel :: [HookRel AnimatorInput]
onAddRel :: [HookRel AnimatorInput]
$conSetRel :: [HookRel AnimatorInput]
onSetRel :: [HookRel AnimatorInput]
$conRemoveRel :: [HookRel AnimatorInput]
onRemoveRel :: [HookRel AnimatorInput]
Component)

newtype AnimationElapsedTime = AnimationElapsedTime Float deriving anyclass (Typeable AnimationElapsedTime
[HookRel AnimationElapsedTime]
[Hook AnimationElapsedTime]
Set DefaultComponentType
IsExclusive (IsExclusiveRel AnimationElapsedTime)
(Typeable AnimationElapsedTime,
 IsExclusive (IsExclusiveRel AnimationElapsedTime)) =>
Set DefaultComponentType
-> [Hook AnimationElapsedTime]
-> [Hook AnimationElapsedTime]
-> [Hook AnimationElapsedTime]
-> [HookRel AnimationElapsedTime]
-> [HookRel AnimationElapsedTime]
-> [HookRel AnimationElapsedTime]
-> Component AnimationElapsedTime
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook AnimationElapsedTime]
onAdd :: [Hook AnimationElapsedTime]
$conSet :: [Hook AnimationElapsedTime]
onSet :: [Hook AnimationElapsedTime]
$conRemove :: [Hook AnimationElapsedTime]
onRemove :: [Hook AnimationElapsedTime]
$conAddRel :: [HookRel AnimationElapsedTime]
onAddRel :: [HookRel AnimationElapsedTime]
$conSetRel :: [HookRel AnimationElapsedTime]
onSetRel :: [HookRel AnimationElapsedTime]
$conRemoveRel :: [HookRel AnimationElapsedTime]
onRemoveRel :: [HookRel AnimationElapsedTime]
Component)

data CurrentAnimation = CurrentAnimation {CurrentAnimation -> AssetRef Animation
animation :: AssetRef Animation, CurrentAnimation -> Int
index :: Int} deriving anyclass (Typeable CurrentAnimation
[HookRel CurrentAnimation]
[Hook CurrentAnimation]
Set DefaultComponentType
IsExclusive (IsExclusiveRel CurrentAnimation)
(Typeable CurrentAnimation,
 IsExclusive (IsExclusiveRel CurrentAnimation)) =>
Set DefaultComponentType
-> [Hook CurrentAnimation]
-> [Hook CurrentAnimation]
-> [Hook CurrentAnimation]
-> [HookRel CurrentAnimation]
-> [HookRel CurrentAnimation]
-> [HookRel CurrentAnimation]
-> Component CurrentAnimation
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook CurrentAnimation]
onAdd :: [Hook CurrentAnimation]
$conSet :: [Hook CurrentAnimation]
onSet :: [Hook CurrentAnimation]
$conRemove :: [Hook CurrentAnimation]
onRemove :: [Hook CurrentAnimation]
$conAddRel :: [HookRel CurrentAnimation]
onAddRel :: [HookRel CurrentAnimation]
$conSetRel :: [HookRel CurrentAnimation]
onSetRel :: [HookRel CurrentAnimation]
$conRemoveRel :: [HookRel CurrentAnimation]
onRemoveRel :: [HookRel CurrentAnimation]
Component)

data AnimatorState where
  AnimatorState :: (Typeable a) => a -> AnimatorState
  deriving (Typeable AnimatorState
[HookRel AnimatorState]
[Hook AnimatorState]
Set DefaultComponentType
IsExclusive (IsExclusiveRel AnimatorState)
(Typeable AnimatorState,
 IsExclusive (IsExclusiveRel AnimatorState)) =>
Set DefaultComponentType
-> [Hook AnimatorState]
-> [Hook AnimatorState]
-> [Hook AnimatorState]
-> [HookRel AnimatorState]
-> [HookRel AnimatorState]
-> [HookRel AnimatorState]
-> Component AnimatorState
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook AnimatorState]
onAdd :: [Hook AnimatorState]
$conSet :: [Hook AnimatorState]
onSet :: [Hook AnimatorState]
$conRemove :: [Hook AnimatorState]
onRemove :: [Hook AnimatorState]
$conAddRel :: [HookRel AnimatorState]
onAddRel :: [HookRel AnimatorState]
$conSetRel :: [HookRel AnimatorState]
onSetRel :: [HookRel AnimatorState]
$conRemoveRel :: [HookRel AnimatorState]
onRemoveRel :: [HookRel AnimatorState]
Component)

data AnimationPlugin

instance Plugin AnimationPlugin where
  init :: System ()
init = do
    Observer (OnSet Animator) -> System ()
forall b. (HasCallStack, Bundle b) => b -> System ()
spawn_ (Observer (OnSet Animator) -> System ())
-> Observer (OnSet Animator) -> System ()
forall a b. (a -> b) -> a -> b
$ (OnSet Animator -> System ()) -> Observer (OnSet Animator)
forall e. (e -> System ()) -> Observer e
Observer OnSet Animator -> System ()
onSetAnimator
    Observer (OnSet AnimatorState) -> System ()
forall b. (HasCallStack, Bundle b) => b -> System ()
spawn_ (Observer (OnSet AnimatorState) -> System ())
-> Observer (OnSet AnimatorState) -> System ()
forall a b. (a -> b) -> a -> b
$ (OnSet AnimatorState -> System ())
-> Observer (OnSet AnimatorState)
forall e. (e -> System ()) -> Observer e
Observer OnSet AnimatorState -> System ()
onSetAnimatorState
    forall sc. Schedule sc => SystemConfig -> System ()
forall {k} (sc :: k). Schedule sc => SystemConfig -> System ()
schedule @Update (SystemConfig -> System ()) -> SystemConfig -> System ()
forall a b. (a -> b) -> a -> b
$ System () -> SystemConfig
forall a. ToSystems a => a -> SystemConfig
systems System ()
progressAnimations
    forall sc. Schedule sc => SystemConfig -> System ()
forall {k} (sc :: k). Schedule sc => SystemConfig -> System ()
schedule @Update (SystemConfig -> System ()) -> SystemConfig -> System ()
forall a b. (a -> b) -> a -> b
$ System () -> SystemConfig
forall a. ToSystems a => a -> SystemConfig
systems System ()
transitionWhen SystemConfig -> (SystemConfig -> SystemConfig) -> SystemConfig
forall a b. a -> (a -> b) -> b
& System () -> SystemConfig -> SystemConfig
forall a. ToSystems a => a -> SystemConfig -> SystemConfig
after System ()
progressAnimations

onSetAnimator :: OnSet Animator -> System ()
onSetAnimator :: OnSet Animator -> System ()
onSetAnimator OnSet {Entity
entity :: Entity
entity :: forall {k} (c :: k). OnSet c -> Entity
entity} = do
  Just (Animator (_ :: anim)) <- Query System Animator -> System (Maybe Animator)
forall w (m :: * -> *) out.
MonadSystem w m =>
Query m out -> m (Maybe out)
single [q|entity. Animator|]
  insert (AnimatorState $ start @anim, CurrentAnimation (animation $ start @anim) 0, AnimationElapsedTime 0) entity

qloadedAnim :: AssetRef Animation -> Query System ()
qloadedAnim :: AssetRef Animation -> Query System ()
qloadedAnim AssetRef Animation
anim = do
  Animation {spritesheet} <- AssetRef Animation -> Query System Animation
forall a (m :: * -> *) w.
MonadSystem w m =>
AssetRef a -> Query m a
qasset' AssetRef Animation
anim
  void $ qasset' $ kdlToAssetRef spritesheet

onSetAnimatorState :: OnSet AnimatorState -> System ()
onSetAnimatorState :: OnSet AnimatorState -> System ()
onSetAnimatorState OnSet {Entity
entity :: forall {k} (c :: k). OnSet c -> Entity
entity :: Entity
entity} = Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
  (Animator (_ :: tag), AnimatorState (state :: state)) <- [q|entity. Animator, AnimatorState|]
  case eqT @state @(State tag) of
    Maybe (a :~: State a)
Nothing -> System () -> Query System ()
forall w (m :: * -> *) a. MonadSystem w m => m a -> Query m a
qlift (System () -> Query System ()) -> System () -> Query System ()
forall a b. (a -> b) -> a -> b
$ Text -> System ()
forall w (m :: * -> *).
(HasCallStack, MonadSystem w m) =>
Text -> m ()
warn [i|Animator state doesn't match the animator's expected state|]
    Just a :~: State a
Refl -> System () -> Query System ()
forall w (m :: * -> *) a. MonadSystem w m => m a -> Query m a
qlift (System () -> Query System ()) -> System () -> Query System ()
forall a b. (a -> b) -> a -> b
$ Entity -> AssetRef Animation -> System ()
setNewAnimation Entity
entity (forall a.
(AnimatorTag a, HasCallStack) =>
State a -> AssetRef Animation
forall {k} (a :: k).
(AnimatorTag a, HasCallStack) =>
State a -> AssetRef Animation
animation @tag a
State a
state)

setNewAnimation :: Entity -> AssetRef Animation -> System ()
setNewAnimation :: Entity -> AssetRef Animation -> System ()
setNewAnimation Entity
entity AssetRef Animation
animation' = do
  AssetRef Animation -> System () -> System ()
waitForAnimation AssetRef Animation
animation' (System () -> System ()) -> System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
    Just animation <- AssetRef Animation -> System (Maybe Animation)
forall a. AssetRef a -> System (Maybe a)
asset AssetRef Animation
animation'
    case animation of
      Animation {dummy :: Animation -> Bool
dummy = Bool
True} -> do
        forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
(AnimationElapsedTime, CurrentAnimation) -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert (Float -> AnimationElapsedTime
AnimationElapsedTime Float
0, AssetRef Animation -> Int -> CurrentAnimation
CurrentAnimation AssetRef Animation
noAnimation Int
0) Entity
entity
      Animation
animation -> Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
        slice <- Maybe SpriteSlice -> Query System SpriteSlice
forall w (m :: * -> *) a. MonadSystem w m => Maybe a -> Query m a
qmaybe (Maybe SpriteSlice -> Query System SpriteSlice)
-> Query System (Maybe SpriteSlice) -> Query System SpriteSlice
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Animation -> Query System (Maybe SpriteSlice)
qanimFrameCoords Int
0 Animation
animation
        image <- qanimImage animation

        qpure entity
          & qinsert
            ( const
                ( CurrentAnimation animation' 0,
                  AnimationElapsedTime 0,
                  Sprite {image},
                  slice
                )
            )

progressAnimations :: System ()
progressAnimations :: System ()
progressAnimations = Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
  delta <- Query System Float
forall w (m :: * -> *). MonadSystem w m => Query m Float
Time.qdelta

  (entity, CurrentAnimation {animation = animation', index}, AnimationElapsedTime time) <- [q|Entity, CurrentAnimation, AnimationElapsedTime|]
  animation <- qasset animation'

  Control.Monad.when animation.dummy qstop

  let time' = Float
time Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
delta
  let frames = Animation -> Int
nframes Animation
animation

  let totalTime = case Animation
animation.time of
        FpsTime Float
t -> Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
t
        TotalTime Float
t -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
int2Float Int
frames

  Control.Monad.when (time < totalTime) $ do
    qpure entity & qinsert (const $ AnimationElapsedTime time')
    qstop

  image <- qanimImage animation

  slice <- qanimFrameCoords (index + 1) animation
  case slice of
    Maybe SpriteSlice
Nothing -> Bool -> Query System () -> Query System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when Animation
animation.loop (Query System () -> Query System ())
-> Query System () -> Query System ()
forall a b. (a -> b) -> a -> b
$ do
      slice <- Maybe SpriteSlice -> Query System SpriteSlice
forall w (m :: * -> *) a. MonadSystem w m => Maybe a -> Query m a
qmaybe (Maybe SpriteSlice -> Query System SpriteSlice)
-> Query System (Maybe SpriteSlice) -> Query System SpriteSlice
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Animation -> Query System (Maybe SpriteSlice)
qanimFrameCoords Int
0 Animation
animation
      qpure entity
        & qinsert
          ( const
              ( CurrentAnimation animation' 0,
                Sprite {image},
                slice,
                AnimationElapsedTime 0
              )
          )
    Just SpriteSlice
slice -> do
      Entity -> Query System ()
forall w (m :: * -> *). MonadSystem w m => Entity -> Query m ()
qpure Entity
entity
        Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (()
 -> (CurrentAnimation, Sprite, SpriteSlice, AnimationElapsedTime))
-> Query System () -> Query System ()
forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System a
qinsert
          ( (CurrentAnimation, Sprite, SpriteSlice, AnimationElapsedTime)
-> ()
-> (CurrentAnimation, Sprite, SpriteSlice, AnimationElapsedTime)
forall a b. a -> b -> a
const
              ( AssetRef Animation -> Int -> CurrentAnimation
CurrentAnimation AssetRef Animation
animation' (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1),
                Sprite {Entity
image :: Entity
image :: Entity
image},
                SpriteSlice
slice,
                Float -> AnimationElapsedTime
AnimationElapsedTime Float
0
              )
          )

input :: forall a. (AnimatorTag a) => (Input a -> Input a) -> Entity -> System ()
input :: forall {k} (a :: k).
AnimatorTag a =>
(Input a -> Input a) -> Entity -> System ()
input Input a -> Input a
f Entity
e = Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
  AnimatorInput (input :: b) <- [q|e. AnimatorInput|]
  case eqT @b @(Input a) of
    Maybe (a :~: Input a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> Text) -> Query System () -> Query System ()
forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn (Text -> () -> Text
forall a b. a -> b -> a
const [i|#{e} doesn't have an animator of type #{typeRep (Proxy @a)}!|])
    Just a :~: Input a
Refl -> Entity -> Query System ()
forall w (m :: * -> *). MonadSystem w m => Entity -> Query m ()
qpure Entity
e Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> AnimatorInput) -> Query System () -> Query System ()
forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System a
qinsert (AnimatorInput -> () -> AnimatorInput
forall a b. a -> b -> a
const (AnimatorInput -> () -> AnimatorInput)
-> AnimatorInput -> () -> AnimatorInput
forall a b. (a -> b) -> a -> b
$ Input a -> AnimatorInput
forall a. Typeable a => a -> AnimatorInput
AnimatorInput (Input a -> AnimatorInput) -> Input a -> AnimatorInput
forall a b. (a -> b) -> a -> b
$ Input a -> Input a
f a
Input a
input)

inputIfNeq :: forall a. (AnimatorTag a, Eq (Input a)) => (Input a -> Input a) -> Entity -> System ()
inputIfNeq :: forall {k} (a :: k).
(AnimatorTag a, Eq (Input a)) =>
(Input a -> Input a) -> Entity -> System ()
inputIfNeq Input a -> Input a
f Entity
e = Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
  AnimatorInput (input :: b) <- [q|e. AnimatorInput|]
  case eqT @b @(Input a) of
    Maybe (a :~: Input a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> Text) -> Query System () -> Query System ()
forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn (Text -> () -> Text
forall a b. a -> b -> a
const [i|#{e} doesn't have an animator of type #{typeRep (Proxy @a)}!|])
    Just a :~: Input a
Refl -> Bool -> Query System () -> Query System ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when (a
input a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= Input a -> Input a
f a
Input a
input) (Query System () -> Query System ())
-> Query System () -> Query System ()
forall a b. (a -> b) -> a -> b
$ Entity -> Query System ()
forall w (m :: * -> *). MonadSystem w m => Entity -> Query m ()
qpure Entity
e Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> AnimatorInput) -> Query System () -> Query System ()
forall b a.
Bundle b =>
(a -> b) -> Query System a -> Query System a
qinsert (AnimatorInput -> () -> AnimatorInput
forall a b. a -> b -> a
const (AnimatorInput -> () -> AnimatorInput)
-> AnimatorInput -> () -> AnimatorInput
forall a b. (a -> b) -> a -> b
$ Input a -> AnimatorInput
forall a. Typeable a => a -> AnimatorInput
AnimatorInput (Input a -> AnimatorInput) -> Input a -> AnimatorInput
forall a b. (a -> b) -> a -> b
$ Input a -> Input a
f a
Input a
input)

transitionWhen :: System ()
transitionWhen :: System ()
transitionWhen = Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
  (e, AnimatorInput (input :: inp), AnimatorState (state :: state), CurrentAnimation {animation = animation', index}, AnimationElapsedTime elapsed, Animator (_ :: tag)) <- [q|E, AnimatorInput, AnimatorState, CurrentAnimation, AnimationElapsedTime, Animator|]

  animation <- qasset animation'
  let frames = Animation -> Int
nframes Animation
animation

  let totalTime = case Animation
animation.time of
        FpsTime Float
t -> Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
t
        TotalTime Float
t -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
int2Float Int
frames

  let status = if Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Float
elapsed Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
totalTime then AnimationStatus
Finished else AnimationStatus
Running

  case eqT @inp @(Input tag) of
    Maybe (a :~: Input a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> Text) -> Query System () -> Query System ()
forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn (Text -> () -> Text
forall a b. a -> b -> a
const [i|Animator and Input Type not matching on #{e}|])
    Just a :~: Input a
Refl -> do
      case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @state @(State tag) of
        Maybe (a :~: State a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> Text) -> Query System () -> Query System ()
forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn (Text -> () -> Text
forall a b. a -> b -> a
const [i|Animator and State Type not matching on #{e}|])
        Just a :~: State a
Refl -> do
          let x :: Maybe (State a)
x = forall a.
AnimatorTag a =>
State a
-> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)
forall {k} (a :: k).
AnimatorTag a =>
State a
-> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)
checkTransitions @tag a
State a
state a
Input a
input Maybe (Shift a)
forall a. Maybe a
Nothing AnimationStatus
status
          case Maybe (State a)
x of
            Maybe (State a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just State a
state -> System () -> Query System ()
forall w (m :: * -> *) a. MonadSystem w m => m a -> Query m a
qlift (System () -> Query System ()) -> System () -> Query System ()
forall a b. (a -> b) -> a -> b
$ do
              forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
AnimatorState -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert (State a -> AnimatorState
forall a. Typeable a => a -> AnimatorState
AnimatorState State a
state) Entity
e

waitForAnimation :: AssetRef Animation -> System () -> System ()
waitForAnimation :: AssetRef Animation -> System () -> System ()
waitForAnimation AssetRef Animation
a System ()
s = (Query System Spritesheet
 -> (Spritesheet -> System ()) -> System ())
-> (Spritesheet -> System ())
-> Query System Spritesheet
-> System ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Query System Spritesheet -> (Spritesheet -> System ()) -> System ()
forall a b.
Typeable a =>
Query System a -> (a -> System b) -> System ()
runWhenOne (System () -> Spritesheet -> System ()
forall a b. a -> b -> a
const System ()
s) (Query System Spritesheet -> System ())
-> Query System Spritesheet -> System ()
forall a b. (a -> b) -> a -> b
$ do
  a <- AssetRef Animation -> Query System Animation
forall a. AssetRef a -> Query System a
qasset AssetRef Animation
a
  qasset $ kdlToAssetRef a.spritesheet

-- whenLoaded' (kdlToAssetRef a.spritesheet) $ const $ do
--   err "ok this also passed.."
--   s

shift :: forall a. (Typeable a) => a -> Entity -> System ()
shift :: forall a. Typeable a => a -> Entity -> System ()
shift a
shift Entity
e = Query System () -> System ()
forall w (m :: * -> *) out. MonadSystem w m => Query m out -> m ()
query_ (Query System () -> System ()) -> Query System () -> System ()
forall a b. (a -> b) -> a -> b
$ do
  (AnimatorInput (inp :: inp), AnimatorState (state :: state), CurrentAnimation {animation = animation', index}, AnimationElapsedTime elapsed, Animator (_ :: tag)) <- [q|e. AnimatorInput, AnimatorState, CurrentAnimation, AnimationElapsedTime, Animator|]

  animation <- qasset animation'
  let frames = Animation -> Int
nframes Animation
animation

  let totalTime = case Animation
animation.time of
        FpsTime Float
t -> Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
t
        TotalTime Float
t -> Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
int2Float Int
frames

  let status = if Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
frames Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Float
elapsed Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
totalTime then AnimationStatus
Finished else AnimationStatus
Running

  case eqT @a @(Shift tag) of
    Maybe (a :~: Shift a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> Text) -> Query System () -> Query System ()
forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn (Text -> () -> Text
forall a b. a -> b -> a
const [i|Animator type doesn't exist on #{e}|])
    Just a :~: Shift a
Refl -> do
      case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @state @(State tag) of
        Maybe (a :~: State a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> Text) -> Query System () -> Query System ()
forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn (Text -> () -> Text
forall a b. a -> b -> a
const [i|Animator and State Type not matching on #{e}|])
        Just a :~: State a
Refl -> do
          case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @inp @(Input tag) of
            Maybe (a :~: Input a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () Query System ()
-> (Query System () -> Query System ()) -> Query System ()
forall a b. a -> (a -> b) -> b
& (() -> Text) -> Query System () -> Query System ()
forall w (m :: * -> *) a.
(HasCallStack, MonadSystem w m) =>
(a -> Text) -> Query m a -> Query m a
qwarn (Text -> () -> Text
forall a b. a -> b -> a
const [i|Animator and Input Type not matching on #{e}|])
            Just a :~: Input a
Refl -> do
              let x :: Maybe (State a)
x = forall a.
AnimatorTag a =>
State a
-> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)
forall {k} (a :: k).
AnimatorTag a =>
State a
-> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)
checkTransitions @tag a
State a
state a
Input a
inp (Shift a -> Maybe (Shift a)
forall a. a -> Maybe a
Just a
Shift a
shift) AnimationStatus
status
              case Maybe (State a)
x of
                Maybe (State a)
Nothing -> () -> Query System ()
forall a. a -> Query System a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                Just State a
state -> System () -> Query System ()
forall w (m :: * -> *) a. MonadSystem w m => m a -> Query m a
qlift (System () -> Query System ()) -> System () -> Query System ()
forall a b. (a -> b) -> a -> b
$ do
                  forall b. (HasCallStack, Bundle b) => b -> Entity -> System ()
AnimatorState -> Entity -> System ()
forall b. Bundle b => b -> Entity -> System ()
insert (State a -> AnimatorState
forall a. Typeable a => a -> AnimatorState
AnimatorState State a
state) Entity
e