tracer/src/Object/Copier.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Object.Copier where

import Affection as A

import Control.Monad (when)
import Control.Monad.IO.Class

import Data.Ecstasy
import Data.String (IsString(..))

import Types

copierObjectAction
  :: (Monad m, MonadIO m, ActionTime ObjType ObjState)
  => Double
  -> ObjType
  -> ObjState
  -> Ent
  -> SystemT Entity m ()
copierObjectAction dt t@ObjCopier s@"copying" ent = do
  emap (anEnt ent) $ do
    mtime <- queryMaybe objStateTime
    case mtime of
      Nothing -> do
        liftIO $ logIO Verbose
          ("Copier " <> fromString (show ent) <> ": copying!")
        return unchanged
          { objStateTime = Set (actionTime t s)
          , objState = Set "copying"
          }
      Just ttl ->
        return unchanged
          { objStateTime = Set (ttl - dt)
          }
  trans <- efor (anEnt ent) $ do
    mttl <- queryMaybe objStateTime
    case mttl of
      Nothing -> return False
      Just ttl -> return (ttl < 0)
  when (head trans) (setEntity ent =<< copierObjectTransition t s False ent Nothing)

copierObjectAction _ _ _ _ = return ()

copierObjectTransition
  :: (Eq a, IsString a, MonadIO m)
  => ObjType
  -> a
  -> Bool
  -> Ent
  -> Maybe Ent
  -> SystemT Entity m (Entity 'SetterOf)
copierObjectTransition ObjCopier "idle" playerActivated ent (Just aent) = do
  e <- efor (anEnt ent) $ do
      let nstat = AnimState
            (AnimId AnimCopier "copy" N)
            0
            0
      return unchanged
        { objState           = Set "copying"
        , objUsedBy          = Set aent
        , objPlayerActivated = Set playerActivated
        , anim               = Set nstat
        }
  return (head e)

copierObjectTransition ObjCopier "copying" _ ent _ = do
  e <- efor (anEnt ent) $ do
    ttl <- query objStateTime
    if ttl < 0
    then do
      let nstat = AnimState
            (AnimId AnimCopier "open" N)
            0
            0
      return unchanged
        { anim               = Set nstat
        , objState           = Set "idle"
        , objStateTime       = Unset
        , objPlayerActivated = Unset
        , objUsedBy          = Unset
        }
    else return unchanged
  return (head e)

copierObjectTransition _ _ _ _ _ = return unchanged