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 -> 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@"on" ent = do
    [vl] <- efor allEnts $ 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 -> do
          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 do
            return (Just pa)
          else if (pa && vl `dot` vl > 0)
            then return (Just pa)
            else return Nothing
    maybe
      (return ())
      (\tpa -> setEntity ent =<< objectTransition t s tpa ent)
      (head trans)

  objectAction dt t@ObjComputer s@"hack" ent = do
    [vl] <- efor allEnts $ 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 -> 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) || vl `dot` vl > 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
      then if 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 do
          let nstat = AnimState
                (AnimId "computer" "on" N)
                0
                0
          return unchanged
              { anim               = Set nstat
              , objState           = Set "on"
              , objPlayerActivated = Set True
              }
      else do
        let nstat = AnimState
              (AnimId "computer" "on" N)
              0
              0
        return unchanged
            { anim               = Set nstat
            , objState           = Set "on"
            , objPlayerActivated = Set False
            }
    return e

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

  objectTransition ObjComputer "hack" pa ent =
    if pa
    then 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          = if pa then Set (ost < 0) else Keep
          }
      return 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