{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} module Object.Door where import Affection as A import Control.Monad (when) import Data.Ecstasy import Data.Maybe import Linear -- internal imports import Types import Object.ActionTime 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 allRelEnts dt t@ObjDoor s@"shut" ent = do permEnts <- efor (anEnt ent) $ do pos' <- query pos rot' <- query rot clvl <- query clearanceLvl let posEnts = filter (\(_, b, _, _) -> (fmap floor b `elem` deltaCoords || fmap floor b == floorPos) && distance b pos' < 0.75) allRelEnts floorPos = fmap floor pos' deltas = case rot' of NW -> [ V2 (-1) 0 , V2 1 0 ] NE -> [ V2 0 (-1) , V2 0 1 ] acceptedRots = case rot' of NW -> [NW, SE] NE -> [NE, SW] deltaCoords = map (floorPos +) deltas predicate (_, _, c, d) = c `elem` acceptedRots && d >= clvl ret = filter predicate posEnts return ret mapM_ (\(e, _, _, _) -> setEntity ent =<< doorObjectTransition t s False ent (Just e)) (head permEnts) doorObjectAction _ _ _ _ _ = return () doorObjectTransition t@ObjDoor s@"shut" _ ent (Just aent) = do [clearance] <- efor (anEnt aent) (query clearanceLvl) e <- efor (anEnt ent) $ do dir <- query rot oclear <- query clearanceLvl liftIO $ A.logIO A.Verbose (show aent ++ " is attempting to open door " ++ show ent) liftIO $ A.logIO A.Verbose ("door clearance: " ++ show oclear ++ ", entity clearance: " ++ show clearance) if clearance >= oclear then do liftIO $ A.logIO A.Verbose ("door " ++ show oclear ++ " opens") let nstat = AnimState (AnimId AnimDoor0 "open" dir) 0 0 return unchanged { objState = Set "open" , objStateTime = Set (actionTime t ("open" :: String)) , objUsedBy = Set aent , anim = Set nstat , 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 , objUsedBy = 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