121 lines
3.5 KiB
Haskell
121 lines
3.5 KiB
Haskell
{-# 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 _ ent (Just aent) = do
|
|
clearance <- head <$> efor (anEnt aent) (query clearanceLvl)
|
|
e <- efor (anEnt ent) $ do
|
|
dir <- query rot
|
|
oclear <- query clearanceLvl
|
|
mttl <- queryMaybe objStateTime
|
|
liftIO $ A.logIO A.Debug (show aent ++ " is attempting to open door " ++ show ent)
|
|
liftIO $ A.logIO A.Debug ("door clearance: " ++ show oclear ++ ", entity clearance: " ++ show clearance)
|
|
if clearance >= oclear
|
|
then do
|
|
liftIO $ A.logIO A.Debug ("door " ++ show oclear ++ " 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
|