Bump character level after touch a power-up ("node").

parent e0951774
......@@ -4,7 +4,6 @@ cabal-version: -any
build-type: Simple
license: OtherLicense
license-file: LICENSE
copyright:
maintainer: Christopher Lane Hinson <lane@downstairspeople.org>
build-depends: hslogger >=1.1.0 && <1.2,
priority-sync >=0.2.1.0 && <0.3, PSQueue >=1.1 && <1.2,
......@@ -14,10 +13,7 @@ build-depends: hslogger >=1.1.0 && <1.2,
mtl >=1.1.0.2 && <1.2, random >=1.0.0.2 && <1.1,
old-time >=1.0.0.3 && <1.1, array >=0.3.0.0 && <0.3.1,
containers >=0.3.0.0 && <0.3.1, base >=4 && <5
stability:
homepage: http://roguestar.downstairspeople.org/
package-url:
bug-reports:
synopsis: Sci-fi roguelike (turn-based, chessboard-tiled, role playing) game
description: Roguestar is a science fiction themed roguelike (turn-based,
chessboard-tiled, role playing) game written in Haskell. This package
......@@ -28,27 +24,10 @@ description: Roguestar is a science fiction themed roguelike (turn-based,
category: Game
author: Christopher Lane Hinson
tested-with: GHC ==6.12.1
data-files:
data-dir: ""
extra-source-files:
extra-tmp-files:
executable: roguestar-engine
main-is: Main.hs
buildable: True
build-tools:
cpp-options:
cc-options:
ld-options:
pkgconfig-depends:
frameworks:
c-sources:
extensions:
extra-libraries:
extra-lib-dirs:
includes:
install-includes:
include-dirs:
hs-source-dirs: src
other-modules: TravelData VisibilityData Stats FactionData Behavior
Alignment PlaneData Grids Perception PlaneVisibility Turns Plane
......@@ -59,9 +38,7 @@ other-modules: TravelData VisibilityData Stats FactionData Behavior
AttributeGeneration CreatureAttribute Building BuildingData Town
Random PlayerState MakeData DBErrorFlag Construction Make Activate
Contact DeviceActivation WorkCluster Planet PlanetData Logging
NodeData
ghc-prof-options: -prof -auto-all
ghc-shared-options: -prof -auto-all
ghc-options: -threaded -fno-warn-type-defaults
hugs-options:
nhc98-options:
jhc-options:
......@@ -17,6 +17,7 @@ import Position
import TerrainData
import Control.Monad.Error
import CreatureData
import NodeData
-- | The total occupied surface area of a building.
buildingSize :: (DBReadable db) => BuildingRef -> db Integer
......@@ -42,8 +43,8 @@ activateFacingBuilding face creature_ref = liftM (fromMaybe False) $ runMaybeT $
activateBuilding building_type creature_ref building_ref
activateBuilding :: BuildingType -> CreatureRef -> BuildingRef -> DB Bool
activateBuilding (Node _) creature_ref building_ref =
do dbModCreature (\c -> c { creature_points = succ $ creature_points c }) creature_ref
activateBuilding (Node n) creature_ref building_ref =
do dbModCreature (applyToCreature n) creature_ref
deleteBuilding building_ref
return True
activateBuilding Portal creature_ref building_ref =
......
......@@ -53,7 +53,7 @@ classInfo :: CharacterClass -> CharacterClassData
-------------------------------------------------------------------------------
--
-- Base Classes
--
--
-- These are base classes: these classes have very low prerequisites,
-- with the intention that characters can choose them at the beginning
-- of a game. They also contain extra information about the character's
......@@ -94,3 +94,14 @@ classInfo Thief = characterClass (mustHave Perception 20) $
classInfo Warrior = characterClass (prerequisites [mustHave Strength 15,mustHave Speed 15]) $
AttackSkill Melee & DefenseSkill Melee & Constitution & Strength & Speed & Mindfulness & Tactical
-------------------------------------------------------------------------------
--
-- Special Classes
--
-- These are special character classes that are gained by taking specific actions.
--
-------------------------------------------------------------------------------
classInfo StarChild = characterClass (prerequisites []) $
Intellect & Indifferent
......@@ -14,6 +14,7 @@ data CharacterClass = Barbarian
| Pirate
| Scout
| Shepherd
| StarChild
| Thief
| Warrior
deriving (Eq,Enum,Bounded,Read,Show,Ord)
......
......@@ -11,6 +11,7 @@ module CreatureData
creatureGender,
creatureAbilityScore,
isFavoredClass,
bumpCharacter,
empty_creature)
where
......@@ -23,6 +24,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import SpeciesData
import TerrainData
import qualified Data.Map as Map
data Creature = Creature { creature_aptitude :: Map.Map CreatureAptitude Integer,
creature_ability :: Map.Map CreatureAbility Integer,
......@@ -181,3 +183,22 @@ creatureGender = creature_gender
isFavoredClass :: CharacterClass -> Creature -> Bool
isFavoredClass character_class creature = character_class `Set.member` (creature_favored_classes creature)
-- |
-- Answers the estimated fitness (powerfulness) of the Creature.
--
creatureFitness :: Creature -> Integer
creatureFitness c = sum $ (Map.elems $ creature_aptitude c) ++ (Map.elems $ creature_ability c)
-- |
-- 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 :: Integer -> Creature -> Creature
bumpCharacter n c = if fitness_gain >= bumped_score
then new_creature { creature_points = bumped_score - fitness_gain }
else c { creature_points = bumped_score }
where bumped_score = creature_points c + n
fitness_gain = creatureFitness new_creature - creatureFitness c
new_creature = applyToCreature (Map.keys $ creature_levels c) c
module NodeData
()
where
import BuildingData
import CreatureData
import CharacterData
data NodeEffect =
ClassBonus CharacterClass
| PointBonus Integer
nodeEffect :: NodeType -> NodeEffect
nodeEffect Anchor = PointBonus 1
nodeEffect Monolith = ClassBonus StarChild
instance CreatureEndo NodeEffect where
applyToCreature (PointBonus bonus) c = bumpCharacter bonus c
applyToCreature (ClassBonus bonus) c = applyToCreature bonus c
instance CreatureEndo NodeType where
applyToCreature n c = applyToCreature (nodeEffect n) c
......@@ -133,7 +133,7 @@ dbOldestSnapshotOnly =
-- otherwise returns an error message.
--
dbRequiresRaceSelectionState :: (DBReadable db) => db a -> db a
dbRequiresRaceSelectionState action =
dbRequiresRaceSelectionState action =
do dbOldestSnapshotOnly
state <- playerState
case state of
......@@ -145,7 +145,7 @@ dbRequiresRaceSelectionState action =
-- otherwise returns an error message.
--
dbRequiresClassSelectionState :: (DBReadable db) => (Creature -> db a) -> db a
dbRequiresClassSelectionState action =
dbRequiresClassSelectionState action =
do dbOldestSnapshotOnly
state <- playerState
case state of
......@@ -164,9 +164,9 @@ dbRequiresPlayerCenteredState action =
do dbOldestSnapshotOnly
state <- playerState
case state of
ClassSelectionState creature -> action creature
PlayerCreatureTurn creature_ref _ -> action =<< dbGetCreature creature_ref
_ -> throwError $ DBError $ "protocol-error: not in player-centered state (" ++ show state ++ ")"
ClassSelectionState creature -> action creature
PlayerCreatureTurn creature_ref _ -> action =<< dbGetCreature creature_ref
_ -> throwError $ DBError $ "protocol-error: not in player-centered state (" ++ show state ++ ")"
-- |
-- Perform an action that works during any creature's turn in a planar environment.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment