Animator.hs

{-# LANGUAGE AllowAmbiguousTypes #-}

module Mischief.Animation.Animator where

import Data.Data
import Data.Kind (Type)
import Data.Maybe
import GHC.Stack (HasCallStack)
import Mischief.Animation.Spritesheet
import Mischief.Assets
import Mischief.ECS

data AnimationStatus = Finished | Running

class (Typeable (Input a), Typeable a, Typeable (State a), Typeable (Shift a)) => AnimatorTag a where
  data State a :: Type
  data Input a :: Type
  data Shift a :: Type

  transition :: State a -> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)
  transition _ _ _ _ = Nothing

  defInput :: Input a
  default defInput :: (Default (Input a)) => Input a
  defInput = def

  animation :: (HasCallStack) => State a -> AssetRef Animation

  start :: State a

data TransitionType = SoftTransition | HardTransition deriving (Eq)

data Transition state input shift = Transition
  { transType :: TransitionType,
    transTo :: state,
    transCond :: Condition input shift
  }

to :: state -> Condition input shift -> Transition state input shift
to b c = Transition {transType = SoftTransition, transTo = b, transCond = c}

to' :: state -> Condition input shift -> Transition state input shift
to' b c = Transition {transType = HardTransition, transTo = b, transCond = c}

data Condition input shift = WhenCondition (input -> Bool) | ShiftCondition shift

when :: (input -> Bool) -> Condition input shift
when = WhenCondition

on :: shift -> Condition input shift
on = ShiftCondition

type IsFinished = Bool

checkTransitions :: forall a. (AnimatorTag a) => State a -> Input a -> Maybe (Shift a) -> AnimationStatus -> Maybe (State a)
checkTransitions = transition