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 Verbose ("Copier " ++ show ent ++ ": copying!")
          return unchanged
            { objStateTime = Set (actionTime t s)
            , objState = Set "copying"
            }
        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 =<< objectTransition t s False ent Nothing)

  objectAction dt t@ObjComputer s@"on" ent = do
    pent <- efor (anEnt ent) $ do
      with objUsedBy
      query objUsedBy
    vls <- efor (anEnt $ head pent) $ do
      with player
      with vel
      query vel
    emap (anEnt ent) $ do
      mtime <- queryMaybe objStateTime
      case mtime of
        Nothing -> do
          liftIO $ logIO Verbose ("Computer " ++ show ent ++ ": on!")
          let dur = actionTime t s
          return unchanged
            { objStateTime = Set dur
            }
        Just ttl ->
          return unchanged
            { objStateTime = Set (ttl - dt)
            }
    trans <- efor (anEnt ent) $ do
      mttl <- queryMaybe objStateTime
      case mttl of
        Nothing -> return Nothing
        Just ttl -> do
          pa <- query objPlayerActivated
          if ttl < 0
          then
            return (Just pa)
          else if not (null vls) && head vls `dot` head vls > 0
            then return (Just pa)
            else return Nothing
    maybe
      (return ())
      (\tpa -> setEntity ent =<< objectTransition t s tpa ent Nothing)
      (head trans)

  objectAction dt t@ObjComputer s@"hack" ent = do
    aent <- efor (anEnt ent) $ do
      with objUsedBy
      query objUsedBy
    vls <- efor (anEnt $ head aent) $ do
      with player
      with vel
      query vel
    emap (anEnt ent) $ do
      mtime <- queryMaybe objStateTime
      case mtime of
        Nothing -> do
          liftIO $ logIO Verbose ("Computer " ++ show ent ++ ": hacking!")
          return unchanged
            { objStateTime = Set (actionTime t s)
            }
        Just ttl ->
          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) || (not (null vls) && head vls `dot` head vls > 0)
          then do
            tpa <- query objPlayerActivated
            return (Just tpa)
          else return Nothing
    maybe
      (return ())
      (\tpa -> setEntity ent =<< objectTransition t s tpa ent Nothing)
      (head trans)

  objectAction _ _ _ _ = return ()

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

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

  objectTransition ObjComputer "off" pa ent (Just aent) = do
    e <- efor (anEnt ent) $ do
      solved <- queryMaybe objSolved
      (_, dir) <- query objAccess
      if pa
      then if not (fromMaybe False solved)
        then do
          let nstat = AnimState
                (AnimId AnimComputer "hack" dir)
                0
                0
          return unchanged
            { anim               = Set nstat
            , objState           = Set "hack"
            , objPlayerActivated = Set True
            , objUsedBy          = Set aent
            }
        else do
          let nstat = AnimState
                (AnimId AnimComputer "on" dir)
                0
                0
          return unchanged
              { anim               = Set nstat
              , objState           = Set "on"
              , objPlayerActivated = Set True
              , objUsedBy          = Set aent
              }
      else do
        let nstat = AnimState
              (AnimId AnimComputer "on" dir)
              0
              0
        return unchanged
            { anim               = Set nstat
            , objState           = Set "on"
            , objPlayerActivated = Set False
            , objUsedBy          = Set aent
            }
    return (head e)

  objectTransition ObjComputer "on" _ ent _ = do
    e <- efor (anEnt ent) $ do
      (_, dir) <- query objAccess
      let nstat = AnimState
            (AnimId AnimComputer "off" dir)
            0
            0
      return unchanged
        { anim               = Set nstat
        , objState           = Set "off"
        , objPlayerActivated = Unset
        , objStateTime       = Unset
        , objUsedBy          = Unset
        }
    return (head e)

  objectTransition ObjComputer "hack" pa ent _ =
    if pa
    then do
      e <- efor (anEnt ent) $ do
        (_, dir) <- query objAccess
        let nstat = AnimState
              (AnimId AnimComputer "off" dir)
              0
              0
        ost <- query objStateTime
        return unchanged
          { anim               = Set nstat
          , objState           = Set "off"
          , objPlayerActivated = Unset
          , objStateTime       = Unset
          , objUsedBy          = Unset
          , objSolved          = if pa then Set (ost < 0) else Keep
          }
      return (head e)
    else return unchanged

  objectTransition _ _ _ _ _ = return unchanged

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

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