tracer/src/Object.hs
2018-08-10 08:58:26 +02:00

96 lines
2.6 KiB
Haskell

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Object where
import Affection
import Control.Monad (when)
import Data.Ecstasy
import Types
instance ObjectAction ObjType ObjState where
-- objectAction ObjCopier "idle" ent = do
-- ud <- getAffection
-- (nws, _) <- liftIO $ yieldSystemT (worldState ud) $ do
-- emap (anEnt ent) $ do
-- with anim
-- mtime <- queryMaybe objStateTime
-- case mtime of
-- Nothing -> do
-- liftIO $ logIO Debug "copying!"
-- let nstat = AnimState
-- (AnimId "copier" "copy" N)
-- 0
-- 0
-- return unchanged
-- { anim = Set nstat
-- , objStateTime = Set 5
-- , objState = "copying"
-- }
-- Just ttl -> do
-- dt <- getDelta
-- return unchanged
-- { objStateTime = Set (ttl - dt)
-- }
-- putAffection ud
-- { worldState = nws
-- }
objectAction dt t@ObjCopier s@"copying" ent = do
emap (anEnt ent) $ do
mtime <- queryMaybe objStateTime
case mtime of
Nothing -> do
liftIO $ logIO Debug ("Copier " ++ show ent ++ ": copying!")
return unchanged
{ objStateTime = Set (actionTime t s)
, objState = Set "copying"
}
Just ttl -> do
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 trans (setEntity ent =<< objectTransition t s ent)
objectAction _ _ _ _ = return ()
objectTransition ObjCopier "idle" ent = do
[e] <- efor (anEnt ent) $ do
let nstat = AnimState
(AnimId "copier" "copy" N)
0
0
return unchanged
{ objState = Set "copying"
, anim = Set nstat
}
return e
objectTransition ObjCopier "copying" ent = do
[e] <- efor (anEnt ent) $ do
let nstat = AnimState
(AnimId "copier" "open" N)
0
0
return unchanged
{ anim = Set nstat
, objState = Set "idle"
, objStateTime = Unset
}
return e
objectTransition _ _ _ = return unchanged
instance ActionTime ObjType ObjState where
actionTime ObjCopier "copying" = 5
actionTime o s = error (show o ++ ": " ++ s ++ ": has not time")