tracer/src/Object/Door.hs

{-# 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] <- 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