{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} module Object.Door where import Affection as A import Control.Monad (when) import Control.Monad.IO.Class (MonadIO) import Data.Ecstasy import Data.Maybe import Data.String -- internal imports import Types import Object.ActionTime () doorObjectAction :: (Eq a, IsString a, MonadIO m) => Double -> ObjType -> a -> Ent -> SystemT Entity m () doorObjectAction dt t@ObjDoor s@"open" ent = do emap (anEnt ent) $ do mtime <- queryMaybe objStateTime case mtime of Nothing -> do return unchanged 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 =<< doorObjectTransition t s False ent Nothing) doorObjectAction _ _ _ _ = return () doorObjectTransition :: (MonadIO m, Eq a, IsString a) => ObjType -> a -> p -> Ent -> Maybe Ent -> SystemT Entity m (Entity 'SetterOf) doorObjectTransition t@ObjDoor _ _ ent (Just aent) = do curClearance <- head <$> efor (anEnt aent) (query clearanceLvl) e <- efor (anEnt ent) $ do dir <- query rot oclear <- query clearanceLvl mttl <- queryMaybe objStateTime liftIO $ A.logIO A.Verbose (fromString (show aent) <> " is attempting to open door " <> fromString (show ent) ) -- liftIO $ A.logIO A.Debug ("door clearance: " ++ show oclear ++ ", entity clearance: " ++ show clearance) if curClearance >= oclear then do liftIO $ A.logIO A.Verbose ("door " <> fromString (show ent) <> " opens") let nstat = AnimState (AnimId AnimDoor0 "open" dir) 0 0 return unchanged { objState = Set "open" , objStateTime = Set (actionTime t ("open" :: String)) , anim = if fromMaybe True (fmap (0 >) mttl) then Set nstat else Keep , obstacle = Unset } else return unchanged return (head e) doorObjectTransition ObjDoor "open" _ ent Nothing = do e <- efor (anEnt ent) $ do ttl <- query objStateTime orientation <- query rot if ttl < 0 then do let nstat = AnimState (AnimId AnimDoor0 "shut" orientation) 0 0 return unchanged { anim = Set nstat , objState = Set "shut" , objStateTime = Unset , obstacle = Set $ case orientation of NW -> Boundaries (4/9, 0) (5/9, 1) NE -> Boundaries (0, 4/9) (1, 5/9) _ -> error "strange orientation for door" } else return unchanged return (head e) doorObjectTransition _ _ _ _ _ = return unchanged