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 _ _ _ _ = 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.Verbose (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.Verbose ("door " ++ 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