Creatures are called monsters now.

parent 4e8fea49
......@@ -18,5 +18,5 @@ run:
./dist/build/roguestar-server/roguestar-server +RTS -xc -p -s 2> ./log/stdout.log
check: clean
cabal-dev configure --ghc-options="-O0"
cabal-dev configure --ghc-options="-O0" --disable-library-profiling --disable-executable-profiling
cabal-dev build
......@@ -62,12 +62,12 @@ data Behavior =
deriving (Show)
-- | Decide which FacingBehavior is most appropriate for for a character's situation.
facingBehavior :: (DBReadable db) => CreatureRef -> Facing -> db FacingBehavior
facingBehavior :: (DBReadable db) => MonsterRef -> Facing -> db FacingBehavior
facingBehavior creature_ref face =
do ((Parent plane_ref,pos) :: (Parent Plane,Position)) <- liftM detail $ getPlanarLocation creature_ref
let facing_pos = offsetPosition (facingToRelative face) pos
t <- terrainAt plane_ref facing_pos
who :: [CreatureRef] <- liftM asChildren $ whatIsOccupying plane_ref facing_pos
who :: [MonsterRef] <- liftM asChildren $ whatIsOccupying plane_ref facing_pos
what :: [BuildingRef] <- liftM asChildren $ whatIsOccupying plane_ref facing_pos
result <- case t of
_ | not (null who) -> return Attack
......@@ -81,17 +81,17 @@ facingBehavior creature_ref face =
-- | Indicates whether or not it is allowed for the specified creature to conduct
-- the specified behavior. A true result here does not guarantee that the action
-- will succeed.
isBehaviorAvailable :: (DBReadable db) => Behavior -> CreatureRef -> db Bool
isBehaviorAvailable :: (DBReadable db) => Behavior -> MonsterRef -> db Bool
isBehaviorAvailable (FacingBehavior Jump _) creature_ref =
do ((Parent plane_ref,pos) :: (Parent Plane,Position)) <- liftM detail $ getPlanarLocation creature_ref
the_terrain <- terrainAt plane_ref pos
creature_has_teleport_ability <- getCreatureSpecial Teleportation creature_ref
creature_has_teleport_ability <- getMonsterSpecial Teleportation creature_ref
return $
creature_has_teleport_ability ||
the_terrain == RecreantFactory
isBehaviorAvailable _ _ = return True
executeBehavior :: Behavior -> CreatureRef -> DB ()
executeBehavior :: Behavior -> MonsterRef -> DB ()
executeBehavior the_behavior the_creature =
do logDB gameplay_log INFO ("Running behavior: behavior=" ++ show the_behavior ++ " creature=" ++ (show $ toUID the_creature))
available <- isBehaviorAvailable the_behavior the_creature
......@@ -99,9 +99,9 @@ executeBehavior the_behavior the_creature =
throwError $ DBError $ "Behavior is not available:" ++ show the_behavior
dbBehave_ the_behavior the_creature
dbBehave_ :: Behavior -> CreatureRef -> DB ()
dbBehave_ :: Behavior -> MonsterRef -> DB ()
dbBehave_ (FacingBehavior Step face) creature_ref =
do (move_from,move_to) <- move creature_ref =<< stepCreature face creature_ref
do (move_from,move_to) <- move creature_ref =<< stepMonster face creature_ref
dbAdvanceTime creature_ref =<< case () of
() | (move_from == move_to) -> return 0
() | face == Here -> actionTime creature_ref -- counts as turning in place
......@@ -123,7 +123,7 @@ dbBehave_ (FacingBehavior Jump face) creature_ref =
dbAdvanceTime creature_ref =<< move2ActionTime creature_ref
dbBehave_ (FacingBehavior TurnInPlace face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
do _ <- move creature_ref =<< turnMonster face creature_ref
dbAdvanceTime creature_ref =<< actionTime creature_ref
dbBehave_ (Pickup tool_ref) creature_ref =
......@@ -140,7 +140,7 @@ dbBehave_ (Wield tool_ref) creature_ref =
() | otherwise -> actionTime creature_ref
dbBehave_ (Unwield) creature_ref =
do dbUnwieldCreature creature_ref
do dbUnwieldMonster creature_ref
dbAdvanceTime creature_ref =<< actionTime creature_ref
dbBehave_ (Drop tool_ref) creature_ref =
......@@ -153,14 +153,14 @@ dbBehave_ (Drop tool_ref) creature_ref =
() | otherwise -> actionTime creature_ref
dbBehave_ (FacingBehavior Fire face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
do _ <- move creature_ref =<< turnMonster face creature_ref
ranged_attack_model <- rangedAttackModel creature_ref
_ <- atomic executeAttackChain $ resolveAttackChain ranged_attack_model (Left face)
dbAdvanceTime creature_ref =<< actionTime creature_ref
return ()
dbBehave_ (FacingBehavior Attack face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
do _ <- move creature_ref =<< turnMonster face creature_ref
melee_attack_model <- meleeAttackModel creature_ref
_ <- atomic executeAttackChain $ resolveAttackChain melee_attack_model (Left face)
dbAdvanceTime creature_ref =<< actionTime creature_ref
......@@ -171,11 +171,11 @@ dbBehave_ Wait creature_ref = dbAdvanceTime creature_ref =<< actionTime creature
dbBehave_ Vanish creature_ref =
do dbAdvanceTime creature_ref =<< actionTime creature_ref
(Parent plane_ref :: Parent Plane) <- liftM detail $ getPlanarLocation creature_ref
faction <- getCreatureFaction creature_ref
faction <- getMonsterFaction creature_ref
is_visible_to_anyone_else <- liftM (any (genericReference 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
when (not is_visible_to_anyone_else) $ deleteMonster creature_ref
return ()
dbBehave_ Activate creature_ref =
......@@ -189,14 +189,14 @@ dbBehave_ (Make make_prep) creature_ref =
return ()
dbBehave_ (FacingBehavior ClearTerrain face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
do _ <- move creature_ref =<< turnMonster face creature_ref
ok <- modifyFacingTerrain clearTerrain face creature_ref
when (not ok) $ throwError $ DBErrorFlag Unable
dbAdvanceTime creature_ref =<< actionTime creature_ref
return ()
dbBehave_ (FacingBehavior ActivateBuilding face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
do _ <- move creature_ref =<< turnMonster face creature_ref
ok <- activateFacingBuilding face creature_ref
when (not ok) $ throwError $ DBErrorFlag Unable
dbAdvanceTime creature_ref =<< actionTime creature_ref
......@@ -205,25 +205,25 @@ dbBehave_ (FacingBehavior ActivateBuilding face) creature_ref =
-- These are functions related to determing how long it takes for a creature to execute an action.
----------------------------------------------------------------------------------------------------}
getBaseSpeed :: (DBReadable db) => CreatureRef -> db Integer
getBaseSpeed :: (DBReadable db) => MonsterRef -> db Integer
getBaseSpeed creature_ref =
do c <- dbGetCreature creature_ref
do c <- dbGetMonster creature_ref
let raw_speed = rawScore Speed c
when (raw_speed <= 0) $ error $ "getBaseSpeed: Non-positive raw speed (" ++ show c ++ ")"
return raw_speed
-- | Time required to do a simple physical task.
actionTime :: (DBReadable db) => CreatureRef -> db Rational
actionTime :: (DBReadable db) => MonsterRef -> db Rational
actionTime creature_ref =
do raw_speed <- getBaseSpeed creature_ref
return $ 1000 % (1000 + raw_speed)
-- | Time required to move one step.
move1ActionTime :: (DBReadable db) => CreatureRef -> db Rational
move1ActionTime :: (DBReadable db) => MonsterRef -> db Rational
move1ActionTime creature_ref =
do raw_speed <- getBaseSpeed creature_ref
return $ 100 % (100+raw_speed)
-- | Time required to move diagonally one step.
move2ActionTime :: (DBReadable db) => CreatureRef -> db Rational
move2ActionTime :: (DBReadable db) => MonsterRef -> db Rational
move2ActionTime = liftM (*1.4142) . move1ActionTime
......@@ -13,11 +13,11 @@ import Roguestar.Lib.Substances
-- | Outcome of activating a tool.
data ActivationOutcome =
Heal CreatureRef Integer
Heal MonsterRef Integer
| ExpendTool ToolRef ActivationOutcome
| NoEffect
resolveActivation :: (DBReadable db) => CreatureRef -> db ActivationOutcome
resolveActivation :: (DBReadable db) => MonsterRef -> db ActivationOutcome
resolveActivation creature_ref =
do tool_ref <- maybe (throwError $ DBErrorFlag NoToolWielded) return =<< getWielded creature_ref
tool <- dbGetTool tool_ref
......@@ -35,7 +35,7 @@ resolveActivation creature_ref =
executeActivation :: ActivationOutcome -> DB ()
executeActivation (NoEffect) = return ()
executeActivation (Heal creature_ref x) =
do healCreature x creature_ref
do healMonster x creature_ref
dbPushSnapshot $ HealEvent creature_ref
executeActivation (ExpendTool tool_ref activation_outcome) =
do executeActivation activation_outcome
......
......@@ -16,25 +16,25 @@ import Roguestar.Lib.PersistantData
data CharacterBumpResult =
CharacterAwarded { character_points_awarded :: Integer,
character_new :: Creature }
character_new :: Monster }
| CharacterAdvanced { character_new_level :: Integer,
character_new :: Creature }
character_new :: Monster }
| CharacterForced { character_new_character_class :: CharacterClass,
character_new :: Creature }
character_new :: Monster }
-- |
-- Increases the character score by the set amount.
-- If the score is high enough that the character can advance to the next level,
-- this function will apply that advancement.
--
bumpCharacter :: PowerUpData -> Creature -> CharacterBumpResult
bumpCharacter :: PowerUpData -> Monster -> CharacterBumpResult
bumpCharacter (ForceCharacter character_class) c =
if CharacterClass character_class `elem` Map.keys (creature_traits c)
then bumpCharacter (AwardCharacter $ characterFitness new_character - characterFitness c) c
else CharacterForced {
character_new_character_class = character_class,
character_new = new_character }
where new_character = applyToCreature character_class c
where new_character = applyToMonster character_class c
bumpCharacter (AwardCharacter n) c =
if fitness_gain >= bumped_score
then CharacterAdvanced {
......@@ -45,7 +45,7 @@ bumpCharacter (AwardCharacter n) c =
character_new = c { creature_points = bumped_score } }
where bumped_score = creature_points c + n
fitness_gain = characterFitness new_character - characterFitness c
new_character = applyToCreature (Map.keys $ creature_traits c) c
new_character = applyToMonster (Map.keys $ creature_traits c) c
newCharacterClass :: CharacterBumpResult -> Maybe CharacterClass
newCharacterClass (CharacterForced character_class _) = Just character_class
......@@ -61,12 +61,12 @@ newCharacterLevel _ = Nothing
-- A rather arbitrary (non-representative of game balance)
-- measure of Character power.
--
characterLevel :: Creature -> Integer
characterLevel :: Monster -> Integer
characterLevel = maximum . Map.elems . creature_traits
-- |
-- Answers the estimated fitness (powerfulness) of the Character.
--
characterFitness :: Creature -> Integer
characterFitness :: Monster -> Integer
characterFitness c = sum $ (Map.elems $ creature_traits c)
......@@ -21,11 +21,11 @@ import Roguestar.Lib.DetailedLocation
import Data.List as List
data AttackModel =
RangedAttackModel CreatureRef ToolRef Device
| MeleeAttackModel CreatureRef ToolRef Device
| UnarmedAttackModel CreatureRef
RangedAttackModel MonsterRef ToolRef Device
| MeleeAttackModel MonsterRef ToolRef Device
| UnarmedAttackModel MonsterRef
attacker :: AttackModel -> CreatureRef
attacker :: AttackModel -> MonsterRef
attacker (RangedAttackModel attacker_ref _ _) = attacker_ref
attacker (MeleeAttackModel attacker_ref _ _) = attacker_ref
attacker (UnarmedAttackModel attacker_ref) = attacker_ref
......@@ -35,14 +35,14 @@ weapon (RangedAttackModel _ weapon_ref _) = Just weapon_ref
weapon (MeleeAttackModel _ weapon_ref _) = Just weapon_ref
weapon (UnarmedAttackModel {}) = Nothing
interactionMode :: AttackModel -> CreatureInteractionMode
interactionMode :: AttackModel -> MonsterInteractionMode
interactionMode (RangedAttackModel {}) = Ranged
interactionMode (MeleeAttackModel {}) = Melee
interactionMode (UnarmedAttackModel {}) = Unarmed
-- | Get the attack model for a creature, based on whatever tool the creature is holding.
-- This will fail if the creature is holding anything other than a weapon.
attackModel :: (DBReadable db) => CreatureRef -> db AttackModel
attackModel :: (DBReadable db) => MonsterRef -> db AttackModel
attackModel attacker_ref =
do m_tool_ref <- getWielded attacker_ref
case m_tool_ref of
......@@ -56,7 +56,7 @@ attackModel attacker_ref =
-- | Get an appropriate melee attack model for a creature, based on whatever tool the creature is holding.
-- This will fail if the creature is holding anything other than a suitable melee weapon (allows unarmed strike).
meleeAttackModel :: (DBReadable db) => CreatureRef -> db AttackModel
meleeAttackModel :: (DBReadable db) => MonsterRef -> db AttackModel
meleeAttackModel attacker_ref =
do attack_model <- attackModel attacker_ref
case interactionMode attack_model `elem` [Melee,Unarmed] of
......@@ -65,7 +65,7 @@ meleeAttackModel attacker_ref =
-- | Get an appropriate ranged attack model for a creature, based on whatever tool the creature is holding.
-- This will fail if the creature is holding anything other than a suitable ranged or splash weapon.
rangedAttackModel :: (DBReadable db) => CreatureRef -> db AttackModel
rangedAttackModel :: (DBReadable db) => MonsterRef -> db AttackModel
rangedAttackModel attacker_ref =
do attack_model <- attackModel attacker_ref
case interactionMode attack_model `elem` [Ranged,Splash] of
......@@ -73,12 +73,12 @@ rangedAttackModel attacker_ref =
_ -> throwError $ DBErrorFlag ToolIs_Innapropriate
data WeaponActivationOutcome =
WeaponExplodes CreatureRef ToolRef Integer
| WeaponMalfunctions CreatureRef ToolRef Integer
WeaponExplodes MonsterRef ToolRef Integer
| WeaponMalfunctions MonsterRef ToolRef Integer
| WeaponFunctions
data AttackOutcome =
AttackMisses CreatureRef (Maybe ToolRef)
AttackMisses MonsterRef (Maybe ToolRef)
| AttackHits Integer
numberOfHits :: AttackOutcome -> Integer
......@@ -86,9 +86,9 @@ numberOfHits (AttackMisses {}) = 0
numberOfHits (AttackHits n) = n
data DamageOutcome =
DamageInflicted CreatureRef (Maybe ToolRef) CreatureRef Integer
| DamageDisarms CreatureRef CreatureRef ToolRef Integer
| DamageSunders CreatureRef ToolRef CreatureRef ToolRef Integer
DamageInflicted MonsterRef (Maybe ToolRef) MonsterRef Integer
| DamageDisarms MonsterRef MonsterRef ToolRef Integer
| DamageSunders MonsterRef ToolRef MonsterRef ToolRef Integer
isDisarmingBlow :: DamageOutcome -> Bool
isDisarmingBlow (DamageInflicted {}) = False
......@@ -96,8 +96,8 @@ isDisarmingBlow _ = True
weighWeaponActivationOutcomes :: (DBReadable db) => AttackModel -> db (WeightedSet WeaponActivationOutcome)
weighWeaponActivationOutcomes attack_model =
do attack_rating <- getCreatureAbilityScore (AttackSkill $ interactionMode attack_model) $ attacker attack_model
damage_rating <- getCreatureAbilityScore (DamageSkill $ interactionMode attack_model) $ attacker attack_model
do attack_rating <- getMonsterAbilityScore (AttackSkill $ interactionMode attack_model) $ attacker attack_model
damage_rating <- getMonsterAbilityScore (DamageSkill $ interactionMode attack_model) $ attacker attack_model
case weapon attack_model of
Nothing -> return $ unweightedSet [WeaponFunctions]
Just weapon_ref ->
......@@ -108,20 +108,20 @@ weighWeaponActivationOutcomes attack_model =
(device_weight, WeaponMalfunctions (attacker attack_model) weapon_ref 1),
(attack_rating+damage_rating, WeaponFunctions)]
weighAttackOutcomes :: (DBReadable db) => AttackModel -> CreatureRef -> db (WeightedSet AttackOutcome)
weighAttackOutcomes :: (DBReadable db) => AttackModel -> MonsterRef -> db (WeightedSet AttackOutcome)
weighAttackOutcomes attack_model defender =
do attack_rating <- getCreatureAbilityScore (AttackSkill $ interactionMode attack_model) $ attacker attack_model
defense_rating <- getCreatureAbilityScore (DefenseSkill $ interactionMode attack_model) $ defender
do attack_rating <- getMonsterAbilityScore (AttackSkill $ interactionMode attack_model) $ attacker attack_model
defense_rating <- getMonsterAbilityScore (DefenseSkill $ interactionMode attack_model) $ defender
return $ weightedSet
[{- TODO: put a "riposte" counter attack if the flub by too much? -- not spending time on it now -}
(defense_rating, AttackMisses (attacker attack_model) (weapon attack_model)),
(attack_rating, AttackHits 1),
(max 0 $ attack_rating - defense_rating, AttackHits $ max 1 $ attack_rating `div` (max 1 defense_rating))]
weighDamageOutcomes :: (DBReadable db) => AttackModel -> CreatureRef -> Maybe ToolRef -> db (WeightedSet DamageOutcome)
weighDamageOutcomes :: (DBReadable db) => AttackModel -> MonsterRef -> Maybe ToolRef -> db (WeightedSet DamageOutcome)
weighDamageOutcomes attack_model defender m_shield =
do damage_rating <- getCreatureAbilityScore (DamageSkill $ interactionMode attack_model) $ attacker attack_model
damage_reduction_rating <- getCreatureAbilityScore (DamageReductionTrait $ interactionMode attack_model) $ defender
do damage_rating <- getMonsterAbilityScore (DamageSkill $ interactionMode attack_model) $ attacker attack_model
damage_reduction_rating <- getMonsterAbilityScore (DamageReductionTrait $ interactionMode attack_model) $ defender
let damageInflicted = DamageInflicted (attacker attack_model) (weapon attack_model) defender
shield_weight <- maybe (return 0) toolValue m_shield
weapon_weight <- maybe (return 0) toolValue $ weapon attack_model
......@@ -149,7 +149,7 @@ data AttackChainOutcome = AttackChainOutcome {
_chain_attack_outcome :: AttackOutcome,
_chain_damage_outcome :: [DamageOutcome] }
resolveAttackChain :: forall db. (DBReadable db) => AttackModel -> Either Facing CreatureRef -> db AttackChainOutcome
resolveAttackChain :: forall db. (DBReadable db) => AttackModel -> Either Facing MonsterRef -> db AttackChainOutcome
resolveAttackChain attack_model e_face_defender =
do m_defender_ref <- case e_face_defender of
Right defender_ref -> return $ Just defender_ref
......@@ -172,11 +172,11 @@ resolveAttackChain attack_model e_face_defender =
executeAttackChain :: AttackChainOutcome -> DB ()
executeAttackChain (AttackChainOutcome (WeaponExplodes attacker_ref tool_ref damage) _ _) =
do injureCreature damage attacker_ref
do injureMonster damage attacker_ref
dbPushSnapshot $ WeaponExplodesEvent attacker_ref tool_ref
deleteTool tool_ref
executeAttackChain (AttackChainOutcome (WeaponMalfunctions attacker_ref tool_ref damage) _ _) =
do injureCreature damage attacker_ref
do injureMonster damage attacker_ref
_ <- move tool_ref =<< dropTool tool_ref
dbPushSnapshot $ WeaponOverheatsEvent attacker_ref tool_ref
return ()
......@@ -187,15 +187,15 @@ executeAttackChain (AttackChainOutcome _ _ damages) =
executeDamage :: DamageOutcome -> DB ()
executeDamage (DamageInflicted attacker_ref m_tool_ref defender_ref damage) =
do injureCreature damage defender_ref
do injureMonster damage defender_ref
dbPushSnapshot $ AttackEvent attacker_ref m_tool_ref defender_ref
executeDamage (DamageDisarms attacker_ref defender_ref dropped_tool damage) =
do injureCreature damage defender_ref
do injureMonster damage defender_ref
dbPushSnapshot $ DisarmEvent attacker_ref defender_ref dropped_tool
_ <- move dropped_tool =<< dropTool dropped_tool
return ()
executeDamage (DamageSunders attacker_ref weapon_ref defender_ref sundered_tool damage) =
do injureCreature damage defender_ref
do injureMonster damage defender_ref
dbPushSnapshot $ SunderEvent attacker_ref weapon_ref defender_ref sundered_tool
deleteTool sundered_tool
......@@ -19,7 +19,7 @@ import Data.Maybe
-- | Modifies terrain in the specified walking direction, returning
-- True iff any terrain modification actually occured.
modifyFacingTerrain :: (Terrain -> Terrain) -> Facing -> CreatureRef -> DB Bool
modifyFacingTerrain :: (Terrain -> Terrain) -> Facing -> MonsterRef -> DB Bool
modifyFacingTerrain f face creature_ref = liftM (fromMaybe False) $ runMaybeT $
do (Parent plane_ref :: Parent Plane,position :: Position) <- MaybeT $ liftM fromLocation $ whereIs creature_ref
let target_position = offsetPosition (facingToRelative face) position
......
......@@ -11,9 +11,9 @@ import Roguestar.Lib.Tool
import Roguestar.Lib.ToolData
import Data.List
data MakeOutcome = MakeSuccess CreatureRef Tool [ToolRef] | MakeFailed
data MakeOutcome = MakeSuccess MonsterRef Tool [ToolRef] | MakeFailed
resolveMake :: (DBReadable db) => CreatureRef -> PrepareMake -> db MakeOutcome
resolveMake :: (DBReadable db) => MonsterRef -> PrepareMake -> db MakeOutcome
resolveMake c (PrepareMake (Just dk) (Just (ch,ch_tool_ref)) (Just (m,m_tool_ref)) (Just (g,g_tool_ref))) =
return $ MakeSuccess c (improvised dk ch m g) [ch_tool_ref,m_tool_ref,g_tool_ref]
resolveMake _ _ = return MakeFailed
......
{-# LANGUAGE ScopedTypeVariables #-}
module Roguestar.Lib.Behavior.Travel
(stepCreature,
turnCreature,
(stepMonster,
turnMonster,
ClimbOutcome,
resolveClimb,
executeClimb,
......@@ -29,11 +29,11 @@ import Roguestar.Lib.TravelData
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.DetailedTravel as DetailedTravel
walkCreature :: (DBReadable db) => Facing ->
walkMonster :: (DBReadable db) => Facing ->
(Integer,Integer) ->
CreatureRef ->
MonsterRef ->
db Standing
walkCreature face (x',y') creature_ref =
walkMonster face (x',y') creature_ref =
do l <- DetailedTravel.whereIs creature_ref
let (Parent plane_ref) = detail l
Position (x,y) = detail l
......@@ -50,24 +50,24 @@ walkCreature face (x',y') creature_ref =
() | otherwise ->
return $ standing
stepCreature :: (DBReadable db) => Facing -> CreatureRef -> db Standing
stepCreature face = walkCreature face (facingToRelative face)
stepMonster :: (DBReadable db) => Facing -> MonsterRef -> db Standing
stepMonster face = walkMonster face (facingToRelative face)
turnCreature :: (DBReadable db) => Facing -> CreatureRef -> db Standing
turnCreature face = walkCreature face (0,0)
turnMonster :: (DBReadable db) => Facing -> MonsterRef -> db Standing
turnMonster face = walkMonster face (0,0)
--------------------------------------------------------------------------------
-- Travel between planes.
--------------------------------------------------------------------------------
data ClimbOutcome =
ClimbGood ClimbDirection CreatureRef Standing
ClimbGood ClimbDirection MonsterRef Standing
| ClimbFailed
-- |
-- Climb up or down between Planes.
--
resolveClimb :: (DBReadable db) => CreatureRef ->
resolveClimb :: (DBReadable db) => MonsterRef ->
ClimbDirection ->
db ClimbOutcome
resolveClimb creature_ref direction = liftM (fromMaybe ClimbFailed) $ runMaybeT $
......@@ -115,16 +115,16 @@ randomTeleportLanding retries plane_ref source_destination goal_destination =
return $ minimumBy (comparing $ \p -> Position.distanceBetweenSquared goal_destination p ^ 2 * Position.distanceBetweenSquared source_destination p) landings
data TeleportJumpOutcome =
TeleportJumpGood CreatureRef Standing
TeleportJumpGood MonsterRef Standing
| TeleportJumpFailed
-- |
-- Teleport jump a creature about 5-7 units in the specified direction.
--
resolveTeleportJump :: (DBReadable db) => CreatureRef -> Facing -> db TeleportJumpOutcome
resolveTeleportJump :: (DBReadable db) => MonsterRef -> Facing -> db TeleportJumpOutcome
resolveTeleportJump creature_ref face = liftM (fromMaybe TeleportJumpFailed) $ runMaybeT $
do start_location <- lift $ DetailedTravel.whereIs creature_ref
jump_roll <- lift $ getCreatureAbilityScore JumpSkill creature_ref
jump_roll <- lift $ getMonsterAbilityScore JumpSkill creature_ref
landing_position <- lift $ randomTeleportLanding (jump_roll `div` 5 + 1)
(asParent $ detail start_location)
(detail start_location) $
......
......@@ -48,7 +48,7 @@ deleteBuilding building_ref = dbUnsafeDeleteObject building_ref
(error "deleteBuilding: impossible case" :: forall m. DBReadable m => Reference () -> m Planar)
-- | Activate the facing building, returns True iff any building was actually activated.
activateFacingBuilding :: Facing -> CreatureRef -> DB Bool
activateFacingBuilding :: Facing -> MonsterRef -> DB Bool
activateFacingBuilding face creature_ref = liftM (fromMaybe False) $ runMaybeT $
do (Parent plane_ref,position) <- MaybeT $ liftM fromLocation $ whereIs creature_ref
buildings <- lift $ liftM mapLocations $ whatIsOccupying plane_ref $ offsetPosition (facingToRelative face) position
......@@ -56,7 +56,7 @@ activateFacingBuilding face creature_ref = liftM (fromMaybe False) $ runMaybeT $
do building_behavior_type <- buildingBehavior building_ref
activateBuilding building_behavior_type creature_ref building_ref
activateBuilding :: BuildingBehavior -> CreatureRef -> BuildingRef -> DB Bool
activateBuilding :: BuildingBehavior -> MonsterRef -> BuildingRef -> DB Bool
activateBuilding (PowerUp pud) creature_ref building_ref =
do captureNode pud creature_ref building_ref
return True
......@@ -77,14 +77,14 @@ activateBuilding (OneWayStargate region) creature_ref building_ref =
() | cy - by == 1 ->
do subsequent_plane <- maybe (throwError $ DBErrorFlag NoStargateAddress) return
=<< getSubsequent region plane_ref
portalCreatureTo Nothing 0 creature_ref subsequent_plane
portalMonsterTo Nothing 0 creature_ref subsequent_plane
() | otherwise -> throwError $ DBErrorFlag BuildingApproachWrongAngle
return True
-- | Deposit a creature in front of (-1) or behind (+1) a random portal on the specified plane. Returns
-- the dbMove result from the action.
portalCreatureTo :: Maybe BuildingBehavior -> Integer -> CreatureRef -> PlaneRef -> DB (Location,Location)
portalCreatureTo building_behavior_type offset creature_ref plane_ref =
portalMonsterTo :: Maybe BuildingBehavior -> Integer -> MonsterRef -> PlaneRef -> DB (Location,Location)
portalMonsterTo building_behavior_type offset creature_ref plane_ref =
do (all_buildings :: [BuildingRef]) <- liftM asChildren (getContents plane_ref)
portals <- filterM (liftM ((== building_behavior_type) . Just) . buildingBehavior) all_buildings
ideal_position <- if null portals
......@@ -95,11 +95,11 @@ portalCreatureTo building_behavior_type offset creature_ref plane_ref =
dbPushSnapshot $ TeleportEvent creature_ref
move creature_ref $ Standing plane_ref position Here
captureNode :: PowerUpData -> CreatureRef -> BuildingRef -> DB ()
captureNode :: PowerUpData -> MonsterRef -> BuildingRef -> DB ()
captureNode power_up_data creature_ref building_ref =
do c <- dbGetCreature creature_ref
do c <- dbGetMonster creature_ref
let result = bumpCharacter power_up_data c
dbModCreature (const $ character_new result) creature_ref
dbModMonster (const $ character_new result) creature_ref
deleteBuilding building_ref
dbPushSnapshot $ BumpEvent {
bump_event_creature = creature_ref,
......
{-# LANGUAGE TypeFamilies, PatternGuards #-}
--Core
module Roguestar.Lib.Core.Monster
(generateInitialPlayerCreature,
newCreature,
getCreatureSpecial,
getCreatureAbilityScore,
getCurrentCreature,
getCreatureFaction,
injureCreature,
healCreature,
getCreatureHealth,
(generateInitialPlayerMonster,
newMonster,
getMonsterSpecial,
getMonsterAbilityScore,
getCurrentMonster,
getMonsterFaction,
injureMonster,
healMonster,
getMonsterHealth,
getDead,
deleteCreature,
deleteMonster,
sweepDead)
where
......@@ -32,78 +32,78 @@ import Roguestar.Lib.Logging
import qualified Data.Set as Set
-- |
-- Generates a new Creature from the specified species.
-- Generates a new Monster from the specified species.
--
generateCreature :: Faction -> Species -> DB Creature
generateCreature faction species =
generateMonster :: Faction -> Species -> DB Monster
generateMonster faction species =
do r <- getRandomR (1,1000000)
return $ applyToCreature (species_specials $ speciesInfo species) $
applyToCreature (species_traits $ speciesInfo species) $
return $ applyToMonster (species_specials $ speciesInfo species) $
applyToMonster (species_traits $ speciesInfo species) $
empty_creature {
creature_species = species,
creature_faction = faction,
creature_random_id = r }
-- |
-- During DBRaceSelectionState, generates a new Creature for the player character.
-- During DBRaceSelectionState, generates a new Monster for the player character.
--
generateInitialPlayerCreature :: Species -> DB ()
generateInitialPlayerCreature species =
do newc <- generateCreature Player species
generateInitialPlayerMonster :: Species -> DB ()
generateInitialPlayerMonster species =
do newc <- generateMonster Player species
setPlayerState $ SpeciesSelectionState $ Just newc
-- |
-- Generates a new Creature from the specified Species and adds it to the database.
-- Generates a new Monster from the specified Species and adds it to the database.
--
newCreature :: (LocationConstructor l, ReferenceTypeOf l ~ Creature) => Faction -> Species -> l -> DB CreatureRef
newCreature faction species loc =
do creature <- generateCreature faction species
dbAddCreature creature loc
newMonster :: (LocationConstructor l, ReferenceTypeOf l ~ Monster) => Faction -> Species -> l -> DB MonsterRef
newMonster faction species loc =
do creature <- generateMonster faction species
dbAddMonster creature loc
getCreatureSpecial :: (DBReadable db) => CreatureSpecial -> CreatureRef -> db Bool
getCreatureSpecial special creature_ref = liftM (Set.member special . creature_specials) $ dbGetCreature creature_ref
getMonsterSpecial :: (DBReadable db) => MonsterSpecial -> MonsterRef -> db Bool
getMonsterSpecial special creature_ref = liftM (Set.member special . creature_specials) $ dbGetMonster creature_ref
getCreatureAbilityScore :: (DBReadable db) => CreatureAbility -> CreatureRef -> db Integer
getCreatureAbilityScore ability creature_ref =
do raw_ideal <- liftM (creatureAbilityScore ability) $ dbGetCreature creature_ref
getMonsterAbilityScore :: (DBReadable db) => MonsterAbility -> MonsterRef -> db Integer
getMonsterAbilityScore ability creature_ref =
do raw_ideal <- liftM (creatureAbilityScore ability) $ dbGetMonster creature_ref
terrain_ideal <- getTerrainAffinity creature_ref
return $ raw_ideal + terrain_ideal
-- | Ability bonus based on being good at working on specific types of terrain.
getTerrainAffinity :: (DBReadable db) => CreatureRef -> db Integer
getTerrainAffinity :: (DBReadable db) => MonsterRef -> db Integer
getTerrainAffinity creature_ref =
do (Parent plane_ref,pos) <- liftM detail $ getPlanarLocation creature_ref
terrain_affinity_points <- liftM sum $ forM [minBound..maxBound] $ \face ->
do t <- terrainAt plane_ref $ offsetPosition (facingToRelative face) pos
liftM (creatureAbilityScore $ TerrainAffinity t) $ dbGetCreature creature_ref
liftM (creatureAbilityScore $ TerrainAffinity t) $ dbGetMonster creature_ref
return $ terrain_affinity_points `div` 4
-- | Get the current creature, if it belongs to the specified faction, based on the current playerState.
getCurrentCreature :: (DBReadable db) => Faction -> db (Maybe CreatureRef)
getCurrentCreature faction =
getCurrentMonster :: (DBReadable db) => Faction -> db (Maybe MonsterRef)
getCurrentMonster faction =
do m_who <- liftM subjectOf $ playerState
is_one_of_us <- maybe (return False) (liftM (== faction) . getCreatureFaction) m_who
is_one_of_us <- maybe (return False) (liftM (== faction) . getMonsterFaction) m_who
return $ if is_one_of_us then m_who else Nothing
getCreatureFaction :: (DBReadable db) => CreatureRef -> db Faction
getCreatureFaction = liftM creature_faction . dbGetCreature
getMonsterFaction :: (DBReadable db) => MonsterRef -> db Faction
getMonsterFaction = liftM creature_faction . dbGetMonster
injureCreature :: Integer -> CreatureRef -> DB ()
injureCreature x = dbModCreature $ \c -> c { creature_damage = max 0 $ creature_damage c + x }
injureMonster :: Integer -> MonsterRef -> DB ()
injureMonster x = dbModMonster $ \c -> c { creature_damage = max 0 $ creature_damage c + x }
healCreature :: Integer -> CreatureRef -> DB ()
healCreature = injureCreature . negate
healMonster :: Integer -> MonsterRef -> DB ()
healMonster = injureMonster . negate
-- | Health as a fraction of 1.
getCreatureHealth :: (DBReadable db) => CreatureRef -> db CreatureHealth
getCreatureHealth creature_ref = liftM creatureHealth $ dbGetCreature creature_ref
getMonsterHealth :: (DBReadable db) => MonsterRef -> db MonsterHealth
getMonsterHealth creature_ref = liftM creatureHealth $ dbGetMonster creature_ref
getDead :: (DBReadable db) => Reference a -> db [CreatureRef]
getDead parent_ref = filterRO (liftM ((<= 0) . creature_health) . getCreatureHealth) =<< liftM asChildren (getContents parent_ref)
getDead :: (DBReadable db) => Reference a -> db [MonsterRef]
getDead parent_ref = filterRO (liftM ((<= 0) . creature_health) . getMonsterHealth) =<< liftM asChildren (getContents parent_ref)
deleteCreature :: CreatureRef -> DB ()
deleteCreature creature_ref =
do logDB gameplay_log INFO $ "deleteCreature; creature=" ++ show (toUID creature_ref)
deleteMonster :: MonsterRef -> DB ()
deleteMonster creature_ref =
do logDB gameplay_log INFO $ "deleteMonster; creature=" ++ show (toUID creature_ref)
planar <- liftM identityDetail $ getPlanarLocation creature_ref
dbUnsafeDeleteObject creature_ref $ const $ return planar
......@@ -111,7 +111,7 @@ deleteCreature creature_ref =
sweepDead :: Reference a -> DB ()
sweepDead ref =