Various changes to gameplay and UI for 0.8.

parent 9195ff6f
-- | Generates random lists of specific data points "attributes" of any data type.
-- The attributes themselves aren't random, only their arrangement and frequency within the list.
--
module Roguestar.Lib.AttributeGeneration
where
import Data.Ratio
import Data.List
import Control.Monad.Random
import Data.Monoid
import Control.Monad
-- | Description of the random data to be generated.
data AttributeGenerator a =
AttributeAlways {
attribute_actual :: a,
attribute_min_max :: (Integer,Integer) }
| AttributeChoice {
attribute_frequency :: Rational,
attribute_yes :: [AttributeGenerator a],
attribute_no :: [AttributeGenerator a] }
instance Monoid (AttributeGenerator a) where
mempty = AttributeChoice {
attribute_frequency = 0,
attribute_yes = [],
attribute_no = [] }
mappend a b = mconcat [a,b]
mconcat as = AttributeChoice {
attribute_frequency = 1,
attribute_yes = as,
attribute_no = [] }
-- | Generate exactly n copies of an attribute.
attributeStatic :: Integer -> a -> AttributeGenerator a
attributeStatic n a =attributeMinMax (n,n) a
-- | Generates between a random number of copies of an attribute between a lower and upper bound.
attributeMinMax :: (Integer,Integer) -> a -> AttributeGenerator a
attributeMinMax min_max a = AttributeAlways {
attribute_actual = a,
attribute_min_max = min_max }
-- | Generates the first class of attributes some fraction of the time, and the other list the remainder of the time.
-- For example 'attributeChoice (1%3) [attributeStatic 1 True] [attributeStatic 1 False]' would generate 'True' 33% of the time.
attributeChoice :: Rational -> [AttributeGenerator a] -> [AttributeGenerator a] -> AttributeGenerator a
attributeChoice freq yes no = AttributeChoice {
attribute_frequency = freq,
attribute_yes = yes,
attribute_no = no }
-- | A set of mutually-exclusive choices, with Integer probability weights.
attributeChoices :: [(Integer,[AttributeGenerator a])] -> AttributeGenerator a
attributeChoices [] = mempty
attributeChoices (x:xs) = attributeChoice (fst x % (sum $ map fst $ x:xs)) (snd x) [attributeChoices xs]
-- | Run the 'AttributeGenerator'.
generateAttributes :: (MonadRandom m) => AttributeGenerator a -> m [a]
generateAttributes (AttributeAlways { attribute_actual = a, attribute_min_max = min_max }) =
do n <- getRandomR min_max
return $ genericReplicate n a
generateAttributes (AttributeChoice { attribute_frequency = l, attribute_yes = yes, attribute_no = no }) =
do n <- getRandomR (1,denominator l)
case () of
() | n <= numerator l -> liftM concat $ mapM generateAttributes yes
() | otherwise -> liftM concat $ mapM generateAttributes no
......@@ -20,43 +20,24 @@ import Roguestar.Lib.Town
import Roguestar.Lib.PlanetData
import Roguestar.Lib.Planet
import qualified Data.ByteString.Char8 as B ()
import Control.Monad.Random
homeBiome :: Species -> Biome
homeBiome Anachronid = ForestBiome
homeBiome Ascendant = MountainBiome
homeBiome Androsynth = IcyRockBiome
homeBiome Caduceator = GrasslandBiome
homeBiome Encephalon = SwampBiome
homeBiome Goliath = DesertBiome
homeBiome Hellion = SwampBiome
homeBiome Kraken = OceanBiome
homeBiome Myrmidon = DesertBiome
homeBiome Perennial = GrasslandBiome
homeBiome Recreant = TundraBiome
homeBiome Reptilian = ForestBiome
homeBiome DustVortex = DesertBiome
homeBiome :: Species -> [Biome]
homeBiome RedRecreant = [ForestBiome,TundraBiome,MountainBiome]
homeBiome BlueRecreant = [ForestBiome,TundraBiome,MountainBiome]
startingEquipmentBySpecies :: Species -> [Tool]
startingEquipmentBySpecies Anachronid = [sphere Radon]
startingEquipmentBySpecies Ascendant = [sphere Neon]
startingEquipmentBySpecies Androsynth = [sphere Silicon]
startingEquipmentBySpecies Caduceator = [sphere Silver]
startingEquipmentBySpecies Encephalon = [sphere Ammonia]
startingEquipmentBySpecies Goliath = [sphere Iron]
startingEquipmentBySpecies Hellion = [sphere Methane]
startingEquipmentBySpecies Kraken = [sphere Substances.Water]
startingEquipmentBySpecies Myrmidon = [sphere Krypton]
startingEquipmentBySpecies Perennial = [sphere Wood]
startingEquipmentBySpecies Recreant = [sphere Malignite]
startingEquipmentBySpecies Reptilian = [sphere Oxygen]
startingEquipmentBySpecies DustVortex = [sphere Aluminum, sphere Nitrogen]
startingEquipmentBySpecies RedRecreant = []
startingEquipmentBySpecies BlueRecreant = []
dbCreateStartingPlane :: Creature -> DB PlaneRef
dbCreateStartingPlane creature =
do dbNewPlane "belhaven" (TerrainGenerationData {
tg_smootheness = 3,
tg_biome = homeBiome $ creature_species creature,
tg_placements = [] }) TheUniverse
do seed <- getRandom
biome <- pickM $ homeBiome (creature_species creature)
dbNewPlane "belhaven" (TerrainGenerationData {
tg_smootheness = 2,
tg_biome = biome,
tg_placements = [recreantFactories seed] }) TheUniverse
-- |
-- Begins the game with the specified starting player creature.
......@@ -71,15 +52,11 @@ beginGame =
landing_site <- pickRandomClearSite 200 30 2 (Position (0,0)) (not . (`elem` difficult_terrains)) plane_ref
creature_ref <- dbAddCreature creature (Standing plane_ref landing_site Here)
setPlayerCreature creature_ref
_ <- createTown plane_ref [basic_stargate,monolith]
_ <- createTown plane_ref [basic_stargate]
let starting_equip = startingEquipmentBySpecies (creature_species creature)
forM_ starting_equip $ \tool -> dbAddTool tool (Inventory creature_ref)
forM_ [0..10] $ \_ -> do tool_position <- pickRandomClearSite 200 1 2 landing_site (not . (`elem` difficult_terrains)) plane_ref
tool_type <- weightedPickM [(8,phase_pistol),(5,phaser),(3,phase_rifle),(8,kinetic_fleuret),(3,kinetic_sabre),
(5,Sphere $ toSubstance Nitrogen),(5,Sphere $ toSubstance Ionidium),(5,Sphere $ toSubstance Aluminum)]
dbAddTool tool_type (Dropped plane_ref tool_position)
(_,end_of_nonaligned_first_series) <- makePlanets (Subsequent plane_ref NonAlignedRegion) =<< generatePlanetInfo nonaligned_first_series_planets
_ <- makePlanets (Subsequent end_of_nonaligned_first_series NonAlignedRegion) =<< generatePlanetInfo nonaligned_second_series_planets
_ <- makePlanets (Subsequent end_of_nonaligned_first_series CyborgRegion) =<< generatePlanetInfo cyborg_planets
-- (_,end_of_nonaligned_first_series) <- makePlanets (Subsequent plane_ref NonAlignedRegion) =<< generatePlanetInfo nonaligned_first_series_planets
-- _ <- makePlanets (Subsequent end_of_nonaligned_first_series NonAlignedRegion) =<< generatePlanetInfo nonaligned_second_series_planets
-- _ <- makePlanets (Subsequent end_of_nonaligned_first_series CyborgRegion) =<< generatePlanetInfo cyborg_planets
setPlayerState $ PlayerCreatureTurn creature_ref
......@@ -94,16 +94,16 @@ dbBehave_ (Step face) creature_ref =
dbBehave_ StepDown creature_ref =
do _ <- atomic executeClimb $ resolveClimb creature_ref ClimbDown
-- FIXME: should be conditional
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbAdvanceTime creature_ref =<< move2ActionTime creature_ref
dbBehave_ StepUp creature_ref =
do _ <- atomic executeClimb $ resolveClimb creature_ref ClimbUp
-- FIXME: should be conditional
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbAdvanceTime creature_ref =<< move2ActionTime creature_ref
dbBehave_ (Jump face) creature_ref =
do _ <- atomic executeTeleportJump $ resolveTeleportJump creature_ref face
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbAdvanceTime creature_ref =<< move2ActionTime creature_ref
dbBehave_ (TurnInPlace face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
......@@ -146,7 +146,7 @@ dbBehave_ (Attack face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
melee_attack_model <- meleeAttackModel creature_ref
_ <- atomic executeAttack $ resolveAttack melee_attack_model face
dbAdvanceTime creature_ref =<< move1ActionTime creature_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
return ()
dbBehave_ Wait creature_ref = dbAdvanceTime creature_ref =<< quickActionTime creature_ref
......@@ -168,60 +168,45 @@ dbBehave_ Activate creature_ref =
dbBehave_ (Make make_prep) creature_ref =
do _ <- atomic executeMake $ resolveMake creature_ref make_prep
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
return ()
dbBehave_ (ClearTerrain face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
ok <- modifyFacingTerrain clearTerrain face creature_ref
when (not ok) $ throwError $ DBErrorFlag Unable
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
return ()
dbBehave_ (ActivateBuilding face) creature_ref =
do _ <- move creature_ref =<< turnCreature face creature_ref
ok <- activateFacingBuilding face creature_ref
when (not ok) $ throwError $ DBErrorFlag Unable
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbAdvanceTime creature_ref =<< quickActionTime 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 . filterLocations (\(Child tool_ref :: Child Tool) -> True)) $ getContents 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 <- liftM creature_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)
getBaseSpeed :: (DBReadable db) => CreatureRef -> db Integer
getBaseSpeed creature_ref =
do c <- dbGetCreature 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.
quickActionTime :: (DBReadable db) => CreatureRef -> db Rational
quickActionTime creature_ref = liftM2 (*) (physicalActionPenalties creature_ref) (liftM ((3%) . rawScore Speed) $ dbGetCreature creature_ref)
quickActionTime creature_ref =
do raw_speed <- getBaseSpeed creature_ref
return $ 50 % (100 + raw_speed `div` 2)
-- | 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)
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 = liftM (*1.4142) . move1ActionTime
-- | Time required to complete a complex physical action.
fullActionTime :: (DBReadable db) => CreatureRef -> db Rational
fullActionTime = liftM (*2) . move1ActionTime
......@@ -46,7 +46,7 @@ walkCreature face (x',y') creature_ref =
(standing_position standing)
case () of
() | not is_passable ->
do logDB log_travel WARNING $ "Terrain not passable."
do logDB log_travel INFO $ "Terrain not passable."
return $ detail l
() | otherwise ->
return $ standing
......
......@@ -24,6 +24,7 @@ import Control.Monad.Error
import Roguestar.Lib.PowerUpData
import Roguestar.Lib.CharacterAdvancement
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.PlayerState
-- | The total occupied surface area of a building.
buildingSize :: (DBReadable db) => BuildingRef -> db Integer
......@@ -60,18 +61,11 @@ activateBuilding (PowerUp pud) creature_ref building_ref =
do captureNode pud creature_ref building_ref
return True
activateBuilding (TwoWayStargate region) creature_ref building_ref =
do (Parent plane_ref :: Parent Plane,Position (bx,by))
<- liftM detail $ getPlanarLocation building_ref
(Position (cx,cy)) <- liftM detail $ getPlanarLocation creature_ref
do (Parent plane_ref :: Parent Plane,building_position :: Position) <- liftM detail $ getPlanarLocation building_ref
(creature_position :: Position) <- liftM detail $ getPlanarLocation creature_ref
case () of
() | cy - by == (-1) ->
do subsequent_plane <- maybe (throwError $ DBErrorFlag NoStargateAddress) return
=<< getSubsequent region plane_ref
portalCreatureTo (Just $ TwoWayStargate region) 1 creature_ref subsequent_plane
() | cy - by == 1 ->
do previous_plane <- maybe (throwError $ DBErrorFlag NoStargateAddress) (return . asParent)
=<< liftM fromLocation (whereIs plane_ref)
portalCreatureTo (Just $ TwoWayStargate region) (-1) creature_ref previous_plane
() | distanceBetweenChessboard creature_position building_position == 1 ->
do setPlayerState $ GameOver PlayerIsVictorious
() | otherwise ->
do throwError $ DBErrorFlag BuildingApproachWrongAngle
return True
......
......@@ -37,8 +37,15 @@ buildingOccupies :: BuildingShape -> [(Integer,Integer)]
-- Monolith/Node: X
buildingOccupies Monolith = [(0,0)]
buildingOccupies Anchor = [(0,0)]
-- Portal: XXX
buildingOccupies Portal = [(0,0),(-1,0),(1,0)]
-- Portal:
--
-- XXX
-- X X
-- X X X
-- X X
-- XXX
--
buildingOccupies Portal = [(0,0),(3,0),(3,1),(3,-1),(-3,0),(-3,1),(-3,-1),(0,3),(-1,3),(1,3),(0,-3),(-1,-3),(1,-3)]
-- Cybergate: XXX
-- XX XX
-- XX XX
......
......@@ -4,15 +4,14 @@ module Roguestar.Lib.Character
where
import Roguestar.Lib.Alignment
import Roguestar.Lib.CreatureAttribute
import Roguestar.Lib.CreatureData
import Roguestar.Lib.TerrainData
import Roguestar.Lib.PersistantData
applyCharacterClass :: CharacterClass -> Creature -> Creature
applyCharacterClass character_class creature = applyToCreature (character_class & classInfo character_class) creature
applyCharacterClass character_class creature = applyToCreature (CharacterClass character_class : classInfo character_class) creature
classInfo :: CharacterClass -> CreatureAttribute
classInfo :: CharacterClass -> [CreatureTrait]
-------------------------------------------------------------------------------
--
......@@ -22,5 +21,5 @@ classInfo :: CharacterClass -> CreatureAttribute
--
-------------------------------------------------------------------------------
classInfo StarChild = Mindfulness & Intellect & Perception
classInfo StarChild = [Aggression,Perception]
......@@ -27,7 +27,7 @@ data CharacterBumpResult =
--
bumpCharacter :: PowerUpData -> Creature -> CharacterBumpResult
bumpCharacter (ForceCharacter character_class) c =
if character_class `elem` Map.keys (creature_levels 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,
......@@ -43,7 +43,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_levels c) c
new_character = applyToCreature (Map.keys $ creature_traits c) c
newCharacterClass :: CharacterBumpResult -> Maybe CharacterClass
newCharacterClass (CharacterForced character_class _) = Just character_class
......@@ -60,11 +60,11 @@ newCharacterLevel _ = Nothing
-- measure of Character power.
--
characterLevel :: Creature -> Integer
characterLevel = maximum . Map.elems . creature_levels
characterLevel = maximum . Map.elems . creature_traits
-- |
-- Answers the estimated fitness (powerfulness) of the Character.
--
characterFitness :: Creature -> Integer
characterFitness c = sum $ (Map.elems $ creature_aptitude c) ++ (Map.elems $ creature_ability c)
characterFitness c = sum $ (Map.elems $ creature_traits c)
......@@ -23,8 +23,8 @@ import Roguestar.Lib.SpeciesData
import Roguestar.Lib.Species
import Roguestar.Lib.FactionData
import Control.Monad.Error
import Control.Monad.Random
import Roguestar.Lib.Tool
import Roguestar.Lib.CreatureAttribute
import Data.Monoid
import Data.Ratio
import Roguestar.Lib.Facing
......@@ -32,12 +32,18 @@ import Roguestar.Lib.Position
import Roguestar.Lib.Plane
import Roguestar.Lib.PlayerState
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.Logging
-- |
-- Generates a new Creature from the specified species.
--
generateCreature :: Faction -> Species -> DB Creature
generateCreature faction species = generateAttributes faction species $ mconcat $ species_starting_attributes $ speciesInfo species
generateCreature faction species =
do r <- getRandomR (1,1000000)
return $ applyToCreature (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.
......@@ -59,13 +65,14 @@ data RollComponents = RollComponents {
component_base :: Integer,
component_other_situation_bonus :: Integer,
component_terrain_affinity_bonus :: Integer }
deriving (Show)
data Roll = Roll {
roll_ideal :: Integer,
roll_actual :: Integer,
roll_ideal_components :: RollComponents,
roll_actual_components :: RollComponents,
roll_log :: Integer }
deriving (Show)
rollCreatureAbilityScore :: (DBReadable db) => CreatureAbility -> Integer -> CreatureRef -> db Roll
rollCreatureAbilityScore score other_ideal creature_ref =
......@@ -75,10 +82,11 @@ rollCreatureAbilityScore score other_ideal creature_ref =
actual <- linearRoll ideal
[raw_actual, other_actual, terrain_actual] <- fixedSumLinearRoll [raw_ideal, other_ideal, terrain_ideal] actual
logarithmic <- logRoll ideal
--trace (show $ (score,raw_ideal,other_ideal,terrain_ideal,raw_actual,other_actual,terrain_actual)) $ return ()
return $ Roll ideal (if raw_actual == 0 then 0 else actual)
(RollComponents raw_ideal other_ideal terrain_ideal)
(RollComponents raw_actual other_actual terrain_actual) logarithmic
let result = Roll ideal (if raw_actual == 0 then 0 else actual)
(RollComponents raw_ideal other_ideal terrain_ideal)
(RollComponents raw_actual other_actual terrain_actual) logarithmic
logDB log_creature DEBUG $ "rollCreatureAbilityScore; result=" ++ show result
return result
-- | Ability bonus based on being good at working on specific types of terrain.
getTerrainAffinity :: (DBReadable db) => CreatureRef -> db Integer
......@@ -114,13 +122,15 @@ getDead parent_ref = filterRO (liftM ((<= 0) . creature_health) . getCreatureHea
deleteCreature :: CreatureRef -> DB ()
deleteCreature creature_ref =
do planar <- liftM identityDetail $ getPlanarLocation creature_ref
do logDB log_creature INFO $ "deleteCreature; creature=" ++ show (toUID creature_ref)
planar <- liftM identityDetail $ getPlanarLocation creature_ref
dbUnsafeDeleteObject creature_ref $ const $ return planar
-- | Delete all dead creatures from the database.
sweepDead :: Reference a -> DB ()
sweepDead ref =
do worst_to_best_critters <- sortByRO (liftM creature_health . getCreatureHealth) =<< getDead ref
do logDB log_creature INFO "sweepDead; sweeping dead creatures"
worst_to_best_critters <- sortByRO (liftM creature_health . getCreatureHealth) =<< getDead ref
flip mapM_ worst_to_best_critters $ \creature_ref ->
do dbPushSnapshot (KilledEvent creature_ref)
deleteCreature creature_ref
module Roguestar.Lib.CreatureAttribute
(CreatureAttribute,
CreatureAttributeGenerator,
gender,
Roguestar.Lib.CreatureAttribute.attributeStatic,
Roguestar.Lib.CreatureAttribute.attributeMinMax,
AG.attributeChoice,
AG.attributeChoices,
Roguestar.Lib.CreatureAttribute.generateAttributes,
(&))
where
import Data.Monoid
import Roguestar.Lib.AttributeGeneration as AG
import Roguestar.Lib.CreatureData
import Control.Monad.Random
import Roguestar.Lib.FactionData
import Roguestar.Lib.SpeciesData
newtype CreatureAttribute = CreatureAttribute { fromCreatureAttribute :: Endo Creature }
instance CreatureEndo CreatureAttribute where
applyToCreature (CreatureAttribute f) = appEndo f
(&) :: (CreatureEndo x,CreatureEndo y) => x -> y -> CreatureAttribute
x & y = CreatureAttribute $ Endo $ applyToCreature x . applyToCreature y
type CreatureAttributeGenerator = AttributeGenerator CreatureAttribute
-- |
-- Generate a ratio of males to females.
--
gender :: Rational -> CreatureAttributeGenerator
gender r = AG.attributeChoice r [Roguestar.Lib.CreatureAttribute.attributeStatic 1 Male]
[Roguestar.Lib.CreatureAttribute.attributeStatic 1 Female]
attributeStatic :: (CreatureEndo a) => Integer -> a -> CreatureAttributeGenerator
attributeStatic n a = AG.attributeStatic n (CreatureAttribute $ Endo $ applyToCreature a)
attributeMinMax :: (CreatureEndo a) => (Integer,Integer) -> a -> CreatureAttributeGenerator
attributeMinMax min_max a = AG.attributeMinMax min_max (CreatureAttribute $ Endo $ applyToCreature a)
generateAttributes :: (MonadRandom m) => Faction -> Species -> CreatureAttributeGenerator -> m Creature
generateAttributes faction species_name attrib_generator =
do attribs <- AG.generateAttributes attrib_generator
random_id <- getRandomR (0,30000)
let c = empty_creature {
creature_species = species_name,
creature_random_id = random_id,
creature_faction = faction }
return $ (appEndo $ mconcat $ map fromCreatureAttribute attribs) c
module Roguestar.Lib.CreatureData
(Creature(..),
CreatureGender(..),
CreatureAptitude(..),
CreatureTrait(..),
CreatureInteractionMode(..),
CreatureAbility(..),
CreatureEndo(..),
CreatureScore(..),
CreatureHealth(..),
creatureGender,
creatureHealth,
creatureAbilityScore,
empty_creature)
......@@ -25,11 +23,7 @@ import qualified Data.Set as Set
import Roguestar.Lib.SpeciesData
import Roguestar.Lib.TerrainData
data Creature = Creature { creature_aptitude :: Map.Map CreatureAptitude Integer,
creature_ability :: Map.Map CreatureAbility Integer,
creature_ethical :: Map.Map EthicalAlignment Integer,
creature_levels :: Map.Map CharacterClass Integer,
creature_gender :: CreatureGender,
data Creature = Creature { creature_traits :: Map.Map CreatureTrait Integer,
creature_species :: Species,
creature_random_id :: Integer, -- random number attached to the creature, not unique
creature_damage :: Integer,
......@@ -41,19 +35,13 @@ data Creature = Creature { creature_aptitude :: Map.Map CreatureAptitude Integer
--
empty_creature :: Creature
empty_creature = Creature {
creature_aptitude = Map.empty,
creature_ability = Map.empty,
creature_ethical = Map.empty,
creature_levels = Map.empty,
creature_gender = Neuter,
creature_traits = Map.empty,
creature_species = error "empty_creature: undefined creature_species",
creature_random_id = error "empty_creature: undefined creature_random_id",
creature_damage = 0,
creature_faction = error "empty_creature: undefined creature_faction",
creature_points = 0 }
data CreatureGender = Male | Female | Neuter deriving (Eq,Read,Show)
-- | Endomorphisms over a 'Creature'. These are types that contribute some feature to a 'Creature',
-- so that 'Creature's can be defined concisely by those properties.
class CreatureEndo a where
......@@ -70,9 +58,6 @@ instance (CreatureEndo a,Integral i) => CreatureEndo (a,i) where
instance (CreatureEndo a) => CreatureEndo [a] where
applyToCreature = appEndo . mconcat . map (Endo . applyToCreature)
instance CreatureEndo CreatureGender where
applyToCreature g c = c { creature_gender = g }
data CreatureHealth = CreatureHealth {
creature_absolute_health :: Integer,
creature_absolute_damage :: Integer,
......@@ -80,21 +65,22 @@ data CreatureHealth = CreatureHealth {
creature_max_health :: Integer }
-- | The seven aptitudes.
data CreatureAptitude =
Strength
| Speed
| Constitution
| Intellect
data CreatureTrait =
Aggression
| Bulk
| Caution
| Dexterity
| Fortitude
| Perception
| Charisma
| Mindfulness
deriving (Eq,Read,Show,Ord,Enum,Bounded)
| Speed
| CharacterClass CharacterClass
deriving (Eq,Read,Show,Ord)
instance CreatureEndo CreatureAptitude where
applyToCreature aptitude c = c { creature_aptitude = Map.insertWith (+) aptitude 1 $ creature_aptitude c }
instance CreatureEndo CreatureTrait where
applyToCreature trait c = c { creature_traits = Map.insertWith (+) trait 1 $ creature_traits c }
instance CreatureScore CreatureAptitude where
rawScore aptitude c = fromMaybe 0 $ Map.lookup aptitude (creature_aptitude c)
instance CreatureScore CreatureTrait where
rawScore trait c = fromMaybe 0 $ Map.lookup trait (creature_traits c)
-- | Combat modes:
-- Melee is armed close-quarters combat with bladed or blunt weapons
......@@ -118,67 +104,37 @@ data CreatureAbility =
| InventorySkill
deriving (Eq,Read,Show,Ord)
instance CreatureEndo CreatureAbility where
applyToCreature ability c = c { creature_ability = Map.insertWith (+) ability 1 $ creature_ability c }
instance CreatureScore CreatureAbility where
rawScore ability c = fromMaybe 0 $ Map.lookup ability $ creature_ability c
instance CreatureEndo EthicalAlignment where
applyToCreature ethical c = c { creature_ethical = Map.insertWith (+) ethical 1 $ creature_ethical c }
instance CreatureScore EthicalAlignment where
rawScore ethical c = fromMaybe 0 $ Map.lookup ethical $ creature_ethical c
instance CreatureEndo CharacterClass where
applyToCreature character_class c = c { creature_levels = Map.insertWith (+) character_class 1 $ creature_levels c }
applyToCreature character_class = applyToCreature (CharacterClass character_class)
instance CreatureScore CharacterClass where
rawScore character_class c = fromMaybe 0 $ Map.lookup character_class $ creature_levels c
rawScore character_class = rawScore (CharacterClass character_class)
-- | Calculator to determine how many ranks a creature has in an ability.
-- Number of aptitude points plus n times number of ability points
figureAbility :: [CreatureAptitude] -> (CreatureAbility,Integer) -> Creature -> Integer
figureAbility aptitude (ability,n) c = sum (map (flip rawScore c) aptitude) + rawScore ability c * n
figureAbility :: [CreatureTrait] -> Creature -> Integer
figureAbility traits c = round $ realToFrac x ** (1.0 / realToFrac (length traits))
where x = product (map ((+1) . flip rawScore c) traits)
creatureAbilityScore :: CreatureAbility -> Creature -> Integer
creatureAbilityScore ToughnessTrait = figureAbility [Strength,Speed,Constitution,Mindfulness] (ToughnessTrait,3)
creatureAbilityScore (AttackSkill Melee) = figureAbility [Strength] (AttackSkill Melee,2)
creatureAbilityScore (DefenseSkill Melee) = figureAbility [Strength] (DefenseSkill Melee,2)
creatureAbilityScore (DamageSkill Melee) = figureAbility [Strength] (DamageSkill Melee,2)
creatureAbilityScore (DamageReductionTrait Melee) = figureAbility [Constitution] (DamageReductionTrait Melee,1)
creatureAbilityScore (ReloadSkill Melee) = figureAbility [Speed] (ReloadSkill Melee,1)
creatureAbilityScore (AttackSkill Ranged) = figureAbility [Perception] (AttackSkill Ranged,2)
creatureAbilityScore (DefenseSkill Ranged) = figureAbility [Perception] (DefenseSkill Ranged,2)
creatureAbilityScore (DamageSkill Ranged) = figureAbility [Perception] (DamageSkill Ranged,2)
creatureAbilityScore (DamageReductionTrait Ranged) = figureAbility [Constitution] (DamageReductionTrait Ranged,1)
creatureAbilityScore (ReloadSkill Ranged) = figureAbility [Speed] (ReloadSkill Ranged,1)
creatureAbilityScore (AttackSkill Unarmed) = figureAbility [Speed] (AttackSkill Unarmed,2)
creatureAbilityScore (DefenseSkill Unarmed) = figureAbility [Speed] (DefenseSkill Unarmed,2)
creatureAbilityScore (DamageSkill Unarmed) = figureAbility [Speed] (DamageSkill Unarmed,2)
creatureAbilityScore (DamageReductionTrait Unarmed) = figureAbility [Constitution] (DamageReductionTrait Unarmed,1)
creatureAbilityScore (ReloadSkill Unarmed) = figureAbility [Speed] (ReloadSkill Unarmed,1)
creatureAbilityScore (AttackSkill Splash) = figureAbility [Intellect] (AttackSkill Splash,2)
creatureAbilityScore (DefenseSkill Splash) = figureAbility [Intellect] (DefenseSkill Splash,2)
creatureAbilityScore (DamageSkill Splash) = figureAbility [Intellect] (DamageSkill Splash,2)
creatureAbilityScore (DamageReductionTrait Splash) = figureAbility [Constitution] (DamageReductionTrait Splash,1)
creatureAbilityScore (ReloadSkill Splash) = figureAbility [Speed] (ReloadSkill Splash,1)
creatureAbilityScore (TerrainAffinity terrain_type) = figureAbility [] (TerrainAffinity terrain_type,1)
creatureAbilityScore HideSkill = figureAbility [Perception] (HideSkill,2)
creatureAbilityScore SpotSkill = figureAbility [Perception] (SpotSkill,2)
creatureAbilityScore JumpSkill = figureAbility [Strength] (JumpSkill,2)
creatureAbilityScore InventorySkill = figureAbility [Strength,Speed,Constitution] (InventorySkill,2)
-- |
-- Answers the gender of this creature.
--
creatureGender :: Creature -> CreatureGender
creatureGender = creature_gender
creatureAbilityScore ToughnessTrait = figureAbility [Caution,Fortitude]
creatureAbilityScore (AttackSkill x) = figureAbility [Aggression,Dexterity]
creatureAbilityScore (DefenseSkill x) = figureAbility [Caution,Dexterity]
creatureAbilityScore (DamageSkill x) = figureAbility [Aggression,Bulk]
creatureAbilityScore (DamageReductionTrait x) = figureAbility [Caution,Bulk]
creatureAbilityScore (ReloadSkill x) = figureAbility [Aggression,Speed]
creatureAbilityScore (TerrainAffinity terrain_type) = figureAbility []
creatureAbilityScore HideSkill = figureAbility [Aggression,Perception]
creatureAbilityScore SpotSkill = figureAbility [Caution,Perception]
creatureAbilityScore JumpSkill = figureAbility [Speed]
creatureAbilityScore InventorySkill = figureAbility [Fortitude]
-- |
-- Answers the health/injury/maximum health of this creature.
creatureHealth :: Creature -> CreatureHealth
creatureHealth c = result
creatureHealth c = case () of
() | creature_max_health result <= 0 -> error "creatureHealth: creature_max_health <= 0"
() | otherwise -> result
where result = CreatureHealth {
creature_health = creature_absolute_health result % creature_max_health result,
creature_absolute_health = creature_max_health result - creature_absolute_damage result,
......
......@@ -504,7 +504,8 @@ dbAdvanceTime ref t = dbSetTimeCoordinate ref =<< (return . (advanceTime t)) =<<
dbNextTurn :: (DBReadable db,ReferenceType a) => [Reference a] -> db (Reference a)
dbNextTurn [] = error "dbNextTurn: empty list"
dbNextTurn refs =
asks (\db -> fst $ minimumBy (comparing snd) $
do logDB log_database INFO $ "Determining whose turn is next among: " ++ (show $ List.map toUID refs)
asks (\db -> fst $ minimumBy (comparing snd) $
List.map (\r -> (r,fromMaybe (error "dbNextTurn: missing time coordinate") $
Map.lookup (genericReference r) (db_time_coordinates db)))