{-# 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.Maybe import Data.String (IsString(..)) import Linear import Types copierObjectAction :: (Monad m, MonadIO m, ActionTime ObjType ObjState) => [(Ent, V2 Double, Direction, Word)] -> 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 " ++ 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