machine.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module RPG.Machine where

import Game.Sequoia (Time)
import Data.Proxy (Proxy (..))

newtype TotalTime = TotalTime Time deriving (Eq, Ord, Num)
newtype StateTime = StateTime Time deriving (Eq, Ord, Num)

class HasMachine state where
    type MachineData state :: *

    start :: Proxy state
          -> (state, MachineData state)

    shouldTerminate :: state
                    -> MachineData state
                    -> TotalTime
                    -> StateTime
                    -> Bool

    pump :: state
         -> MachineData state
         -> TotalTime
         -> StateTime
         -> (state, MachineData state)


data Machine where
    Machine :: HasMachine m => (m, MachineData m) -> Machine

newMachine :: forall m. HasMachine m => Proxy m -> Machine
newMachine proxy = Machine $ start proxy

pumpMachine :: TotalTime -> StateTime -> Machine -> Maybe Machine
pumpMachine tt st (Machine (s, d)) =
    if shouldTerminate s d tt st
       then Nothing
       else Just . Machine $ pump s d tt st


-------------------------------------------------

data Fireball = Animate | Mash | Payload

instance HasMachine Fireball where
    type MachineData Fireball = Int

    shouldTerminate Payload 0 _ _ = True
    shouldTerminate _ _ _ _       = False

    start _ = (Animate, 0)

    pump Animate _ _ st
        | st >= 1   = (Mash, 0)
        | otherwise = (Animate, 0)

    pump Mash i _ st
        | st >= 3   = (Payload, i)
        | otherwise = (Mash, i + 1)

    pump Payload i _ _ = (Payload, i - 1)