tracer/src/Object/Copier.hs

93 lines
2.4 KiB
Haskell
Raw Normal View History

2019-02-15 10:22:24 +00:00
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module Object.Copier where
import Affection as A
import Control.Monad (when)
2019-03-07 00:33:51 +00:00
import Control.Monad.IO.Class
2019-02-15 10:22:24 +00:00
import Data.Ecstasy
import Data.Maybe
2019-03-07 00:33:51 +00:00
import Data.String (IsString(..))
2019-02-15 10:22:24 +00:00
import Linear
import Types
2019-03-07 00:33:51 +00:00
copierObjectAction
:: (Monad m, MonadIO m, ActionTime ObjType ObjState)
=> [(Ent, V2 Double, Direction, Word)]
-> Double
-> ObjType
-> ObjState
-> Ent
-> SystemT Entity m ()
2019-02-18 18:14:41 +00:00
copierObjectAction _ dt t@ObjCopier s@"copying" ent = do
2019-02-15 10:22:24 +00:00
emap (anEnt ent) $ do
mtime <- queryMaybe objStateTime
case mtime of
Nothing -> do
liftIO $ logIO Verbose ("Copier " ++ 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)
2019-02-18 18:14:41 +00:00
copierObjectAction _ _ _ _ _ = return ()
2019-02-15 10:22:24 +00:00
2019-03-07 00:33:51 +00:00
copierObjectTransition
:: (Eq a, IsString a, MonadIO m)
=> ObjType
-> a
-> Bool
-> Ent
-> Maybe Ent
-> SystemT Entity m (Entity 'SetterOf)
2019-02-15 10:22:24 +00:00
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