Animation.hs

{-# 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 $ \HookContext {entity} -> do
        Just (Animator (_ :: a)) <- single [q|entity. Animator|]
        insert (AnimatorInput (defInput @a)) entity
    ]

data AnimatorInput where
  AnimatorInput :: (Typeable a) => a -> AnimatorInput
  deriving (Component)

newtype AnimationElapsedTime = AnimationElapsedTime Float deriving anyclass (Component)

data CurrentAnimation = CurrentAnimation {animation :: AssetRef Animation, index :: Int} deriving anyclass (Component)

data AnimatorState where
  AnimatorState :: (Typeable a) => a -> AnimatorState
  deriving (Component)

data AnimationPlugin

instance Plugin AnimationPlugin where
  init = do
    spawn_ $ Observer onSetAnimator
    spawn_ $ Observer onSetAnimatorState
    schedule @Update $ systems progressAnimations
    schedule @Update $ systems transitionWhen & after progressAnimations

onSetAnimator :: OnSet Animator -> System ()
onSetAnimator OnSet {entity} = do
  Just (Animator (_ :: anim)) <- single [q|entity. Animator|]
  insert (AnimatorState $ start @anim, CurrentAnimation (animation $ start @anim) 0, AnimationElapsedTime 0) entity

qloadedAnim :: AssetRef Animation -> Query System ()
qloadedAnim anim = do
  Animation {spritesheet} <- qasset' anim
  void $ qasset' $ kdlToAssetRef spritesheet

onSetAnimatorState :: OnSet AnimatorState -> System ()
onSetAnimatorState OnSet {entity} = query_ $ do
  (Animator (_ :: tag), AnimatorState (state :: state)) <- [q|entity. Animator, AnimatorState|]
  case eqT @state @(State tag) of
    Nothing -> qlift $ warn [i|Animator state doesn't match the animator's expected state|]
    Just Refl -> qlift $ setNewAnimation entity (animation @tag state)

setNewAnimation :: Entity -> AssetRef Animation -> System ()
setNewAnimation entity animation' = do
  waitForAnimation animation' $ do
    Just animation <- asset animation'
    case animation of
      Animation {dummy = True} -> do
        insert (AnimationElapsedTime 0, CurrentAnimation noAnimation 0) entity
      animation -> query_ $ do
        slice <- qmaybe =<< qanimFrameCoords 0 animation
        image <- qanimImage animation

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

progressAnimations :: System ()
progressAnimations = query_ $ do
  delta <- Time.qdelta

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

  Control.Monad.when animation.dummy qstop

  let time' = time + delta
  let frames = nframes animation

  let totalTime = case animation.time of
        FpsTime t -> 1 / t
        TotalTime t -> t / int2Float 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
    Nothing -> Control.Monad.when animation.loop $ do
      slice <- qmaybe =<< qanimFrameCoords 0 animation
      qpure entity
        & qinsert
          ( const
              ( CurrentAnimation animation' 0,
                Sprite {image},
                slice,
                AnimationElapsedTime 0
              )
          )
    Just slice -> do
      qpure entity
        & qinsert
          ( const
              ( CurrentAnimation animation' (index + 1),
                Sprite {image},
                slice,
                AnimationElapsedTime 0
              )
          )

input :: forall a. (AnimatorTag a) => (Input a -> Input a) -> Entity -> System ()
input f e = query_ $ do
  AnimatorInput (input :: b) <- [q|e. AnimatorInput|]
  case eqT @b @(Input a) of
    Nothing -> pure () & qwarn (const [i|#{e} doesn't have an animator of type #{typeRep (Proxy @a)}!|])
    Just Refl -> qpure e & qinsert (const $ AnimatorInput $ f input)

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

transitionWhen :: System ()
transitionWhen = query_ $ 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 = nframes animation

  let totalTime = case animation.time of
        FpsTime t -> 1 / t
        TotalTime t -> t / int2Float frames

  let status = if index == frames - 1 && elapsed >= totalTime then Finished else Running

  case eqT @inp @(Input tag) of
    Nothing -> pure () & qwarn (const [i|Animator and Input Type not matching on #{e}|])
    Just Refl -> do
      case eqT @state @(State tag) of
        Nothing -> pure () & qwarn (const [i|Animator and State Type not matching on #{e}|])
        Just Refl -> do
          let x = checkTransitions @tag state input Nothing status
          case x of
            Nothing -> pure ()
            Just state -> qlift $ do
              insert (AnimatorState state) e

waitForAnimation :: AssetRef Animation -> System () -> System ()
waitForAnimation a s = flip runWhenOne (const s) $ do
  a <- qasset 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 shift e = query_ $ 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 = nframes animation

  let totalTime = case animation.time of
        FpsTime t -> 1 / t
        TotalTime t -> t / int2Float frames

  let status = if index == frames - 1 && elapsed >= totalTime then Finished else Running

  case eqT @a @(Shift tag) of
    Nothing -> pure () & qwarn (const [i|Animator type doesn't exist on #{e}|])
    Just Refl -> do
      case eqT @state @(State tag) of
        Nothing -> pure () & qwarn (const [i|Animator and State Type not matching on #{e}|])
        Just Refl -> do
          case eqT @inp @(Input tag) of
            Nothing -> pure () & qwarn (const [i|Animator and Input Type not matching on #{e}|])
            Just Refl -> do
              let x = checkTransitions @tag state inp (Just shift) status
              case x of
                Nothing -> pure ()
                Just state -> qlift $ do
                  insert (AnimatorState state) e