{-# LANGUAGE ExistentialQuantification, Rank2Types, ScopedTypeVariables #-}
module Behavior
(Behavior(..),
facingBehavior,
dbBehave)
where
import DB
import Position
import Facing
import Data.Ratio
import Tool
import Control.Monad.Error
import Combat
import Activate
import Travel
import Creature
import CreatureData
import Plane
import PlaneVisibility
import Data.List
import Control.Monad.Maybe
import TerrainData
import Make
import Construction
import Building
--
-- Every possible behavior that a creature might take, AI or Human.
--
data Behavior =
Step Facing
| TurnInPlace Facing
| Jump Facing
| Pickup ToolRef
| Wield ToolRef
| Unwield
| Drop ToolRef
| Fire Facing
| Attack Facing
| Wait
| Vanish
| Activate
| Make PrepareMake
| ClearTerrain Facing
| ActivateBuilding Facing
-- | Get an appropriate behavior facing in the given direction.
-- If the adjacent facing square is empty, this is 'Step', but
-- if occupied by a creature this is 'Attack'.
facingBehavior :: (DBReadable db) => CreatureRef -> Facing -> db Behavior
facingBehavior creature_ref face =
do (m_standing :: Maybe (PlaneRef,Position)) <- liftM (fmap location) $ getPlanarPosition creature_ref
case m_standing of
Nothing -> return Wait
Just (plane_ref,pos) ->
do let facing_pos = offsetPosition (facingToRelative face) pos
t <- terrainAt plane_ref facing_pos
who :: [CreatureRef] <- whatIsOccupying plane_ref facing_pos
what :: [BuildingRef] <- whatIsOccupying plane_ref facing_pos
case t of
_ | not (null who) -> return $ Attack face
_ | not (null what) -> return $ ActivateBuilding face
Forest -> return $ TurnInPlace face
DeepForest -> return $ TurnInPlace face
RockFace -> return $ TurnInPlace face
_ -> return $ Step face
dbBehave :: Behavior -> CreatureRef -> DB ()
dbBehave (Step face) creature_ref =
do (move_from,move_to) <- dbMove (stepCreature face) creature_ref
dbAdvanceTime creature_ref =<< case () of
() | (move_from == move_to) -> return 0
() | face == Here -> quickActionTime creature_ref -- counts as turning in place
() | face `elem` [North,South,East,West] -> move1ActionTime creature_ref
() | otherwise -> move2ActionTime creature_ref
dbBehave (Jump face) creature_ref =
do atomic $ liftM executeTeleportJump $ resolveTeleportJump creature_ref face
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbBehave (TurnInPlace face) creature_ref =
do _ <- dbMove (turnCreature face) creature_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
dbBehave (Pickup tool_ref) creature_ref =
do _ <- dbMove (dbPickupTool creature_ref) tool_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
dbBehave (Wield tool_ref) creature_ref =
do available <- availableWields creature_ref
already_wielded <- dbGetWielded creature_ref
when (not $ tool_ref `elem` available) $ throwError $ DBErrorFlag ToolIs_Unreachable
_ <- dbMove dbWieldTool tool_ref
dbAdvanceTime creature_ref =<< case () of
() | Just tool_ref == already_wielded -> return 0 -- already wielded, so this was an empty action
() | otherwise -> quickActionTime creature_ref
dbBehave (Unwield) creature_ref =
do dbUnwieldCreature creature_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
dbBehave (Drop tool_ref) creature_ref =
do tool_parent <- liftM extractLocation $ dbWhere tool_ref
already_wielded <- dbGetWielded creature_ref
when (tool_parent /= Just creature_ref) $ throwError $ DBErrorFlag ToolIs_NotInInventory
_ <- dbMove dbDropTool tool_ref
dbAdvanceTime creature_ref =<< case () of
() | Just tool_ref == already_wielded -> return 0 -- instantly drop a tool if it's already held in the hand
() | otherwise -> quickActionTime creature_ref
dbBehave (Fire face) creature_ref =
do _ <- dbMove (turnCreature face) creature_ref
ranged_attack_model <- rangedAttackModel creature_ref
atomic $ liftM executeAttack $ resolveAttack ranged_attack_model face
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
return ()
dbBehave (Attack face) creature_ref =
do _ <- dbMove (turnCreature face) creature_ref
melee_attack_model <- meleeAttackModel creature_ref
atomic $ liftM executeAttack $ resolveAttack melee_attack_model face
dbAdvanceTime creature_ref =<< move1ActionTime creature_ref
return ()
dbBehave Wait creature_ref = dbAdvanceTime creature_ref =<< quickActionTime creature_ref
dbBehave Vanish creature_ref =
do dbAdvanceTime creature_ref =<< quickActionTime creature_ref
_ <- runMaybeT $
do (plane_ref :: PlaneRef) <- MaybeT $ liftM (fmap location) $ getPlanarPosition creature_ref
lift $
do faction <- getCreatureFaction creature_ref
is_visible_to_anyone_else <- liftM (any (creature_ref `elem`)) $
mapM (\fact -> dbGetVisibleObjectsForFaction (return . const True) fact plane_ref)
({- all factions except this one: -} delete faction [minBound..maxBound])
when (not is_visible_to_anyone_else) $ deleteCreature creature_ref
return ()
dbBehave Activate creature_ref =
do atomic $ liftM executeActivation $ resolveActivation creature_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
return ()
dbBehave (Make make_prep) creature_ref =
do atomic $ liftM executeMake $ resolveMake creature_ref make_prep
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
return ()
dbBehave (ClearTerrain face) creature_ref =
do _ <- dbMove (turnCreature face) creature_ref
ok <- modifyFacingTerrain clearTerrain face creature_ref
when (not ok) $ throwError $ DBErrorFlag Unable
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
return ()
dbBehave (ActivateBuilding face) creature_ref =
do _ <- dbMove (turnCreature face) creature_ref
ok <- activateFacingBuilding face creature_ref
when (not ok) $ throwError $ DBErrorFlag Unable
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
{---------------------------------------------------------------------------------------------------
-- These are functions related to determing how long it takes for a creature to execute an action.
----------------------------------------------------------------------------------------------------}
-- | A value indicating the degree of difficulty a creature suffers on account of the inventory it is carrying.
inventoryBurden :: (DBReadable db) => CreatureRef -> db Rational
inventoryBurden creature_ref =
do inventory_size <- liftM (genericLength . map (asReferenceTyped _tool)) $ dbGetContents creature_ref
inventory_skill <- liftM roll_ideal $ rollCreatureAbilityScore InventorySkill 0 creature_ref
return $ (inventory_size ^ 2) % inventory_skill
-- | Multiplier penalty if a creature is overweighted.
overweightPenalty :: (DBReadable db) => CreatureRef -> db Rational
overweightPenalty = liftM (max 1.0) . inventoryBurden
-- | Multiplier penalty if a creature is injured.
healthPenalty :: (DBReadable db) => CreatureRef -> db Rational
healthPenalty creature_ref =
do current_health <- getCreatureHealth creature_ref
raw_speed <- liftM (rawScore Speed) $ dbGetCreature creature_ref
return $ (max 1.0 $ recip $ max (1%raw_speed) current_health) -- maximum health penalty determined by speed
-- | Multiplier penalties for doing anything that requires physical movement, e.g. walking.
physicalActionPenalties :: (DBReadable db) => CreatureRef -> db Rational
physicalActionPenalties creature_ref = liftM2 (*) (overweightPenalty creature_ref) (healthPenalty creature_ref)
-- | Time required to do a simple physical task.
quickActionTime :: (DBReadable db) => CreatureRef -> db Rational
quickActionTime creature_ref = liftM2 (*) (physicalActionPenalties creature_ref) (liftM ((3%) . rawScore Speed) $ dbGetCreature creature_ref)
-- | Time required to move one step.
move1ActionTime :: (DBReadable db) => CreatureRef -> db Rational
move1ActionTime creature_ref = liftM2 (*) (physicalActionPenalties creature_ref) (liftM ((5%) . rawScore Speed) $ dbGetCreature creature_ref)
-- | Time required to move diagonally one step.
move2ActionTime :: (DBReadable db) => CreatureRef -> db Rational
move2ActionTime = liftM (*1.4142) . move1ActionTime
-- | Time required to complete a complex physical action.
fullActionTime :: (DBReadable db) => CreatureRef -> db Rational
fullActionTime = liftM (*2) . move1ActionTime