tracer/src/Object.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Object where

import Affection as A

import Control.Monad (when)

import Data.Ecstasy
import Data.Maybe

import Linear

import Types

instance ObjectAction ObjType ObjState where
  objectAction dt t@ObjCopier s@"copying" ent = do
    emap (anEnt ent) $ do
      mtime <- queryMaybe objStateTime
      case mtime of
        Nothing -> do
          liftIO $ logIO Debug ("Copier " ++ show ent ++ ": copying!")
          return unchanged
            { objStateTime = Set (actionTime t s)
            , objState = Set "copying"
            }
        Just ttl -> do
          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 trans (setEntity ent =<< objectTransition t s False ent)

  objectAction dt t@ObjComputer s@"hack" ent = do
    [vel] <- efor allEnts $ do
      with player
      with vel
      query vel
    emap (anEnt ent) $ do
      mtime <- queryMaybe objStateTime
      case mtime of
        Nothing -> do
          liftIO $ logIO Debug ("Computer " ++ show ent ++ ": hacking!")
          return unchanged
            { objStateTime = Set (actionTime t s)
            }
        Just ttl -> do
          return unchanged
            { objStateTime = Set (ttl - dt)
            }
    [trans] <- efor (anEnt ent) $ do
      mttl <- queryMaybe objStateTime
      case mttl of
        Nothing -> return Nothing
        Just ttl -> do
          if (ttl < 0) || vel `dot` vel > 0
          then do
            tpa <- query objPlayerActivated
            return (Just tpa)
          else return Nothing
    maybe
      (return ())
      (\tpa -> setEntity ent =<< objectTransition t s tpa ent)
      trans

  objectAction _ _ _ _ = return ()

  objectTransition ObjCopier "idle" playerActivated ent = do
    [e] <- efor (anEnt ent) $ do
        let nstat = AnimState
              (AnimId "copier" "copy" N)
              0
              0
        return unchanged
          { objState           = Set "copying"
          , objPlayerActivated = Set playerActivated
          , anim               = Set nstat
          }
    return e

  objectTransition ObjCopier "copying" _ ent = do
    [e] <- efor (anEnt ent) $ do
      ttl <- query objStateTime
      if ttl < 0
      then do
        let nstat = AnimState
              (AnimId "copier" "open" N)
              0
              0
        return unchanged
          { anim               = Set nstat
          , objState           = Set "idle"
          , objStateTime       = Unset
          , objPlayerActivated = Unset
          }
      else return unchanged
    return e

  objectTransition ObjComputer "off" pa ent = do
    [e] <- efor (anEnt ent) $ do
      solved <- queryMaybe objSolved
      if pa && not (fromMaybe False solved)
      then do
        let nstat = AnimState
              (AnimId "computer" "hack" N)
              0
              0
        return unchanged
          { anim               = Set nstat
          , objState           = Set "hack"
          , objPlayerActivated = Set True
          }
      else return unchanged
    return e

  objectTransition ObjComputer "hack" _ ent = do
    [e] <- efor (anEnt ent) $ do
      let nstat = AnimState
            (AnimId "computer" "off" N)
            0
            0
      ost <- query objStateTime
      return unchanged
        { anim               = Set nstat
        , objState           = Set "off"
        , objPlayerActivated = Unset
        , objStateTime       = Unset
        , objSolved          = Set (ost < 0)
        }
    return e

  objectTransition _ _ _ _ = return unchanged

instance ActionTime ObjType ObjState where
  actionTime ObjCopier "copying" = 5
  actionTime ObjComputer "off" = 0
  actionTime ObjComputer "hack" = 20

  actionTime o s = A.log Error (show o ++ ": " ++ s ++ ": has not time") 0