tracer/src/Object/Door.hs

121 lines
3.4 KiB
Haskell
Raw Normal View History

2019-02-16 19:38:00 +00:00
{-# 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
2019-02-18 18:14:41 +00:00
doorObjectAction _ dt t@ObjDoor s@"open" ent = do
2019-02-16 19:38:00 +00:00
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)
2019-02-18 18:14:41 +00:00
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 ()
2019-02-16 19:38:00 +00:00
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
2019-02-18 18:14:41 +00:00
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
2019-02-16 19:38:00 +00:00
then do
2019-02-18 18:14:41 +00:00
liftIO $ A.logIO A.Verbose ("door " ++ show oclear ++ " opens")
2019-02-16 19:38:00 +00:00
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