Permalink
Browse files

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

  • Loading branch information...
1 parent e095177 commit 43382b73944acf0d654f2f5e839e6f67bb79d249 @clanehin committed Jan 14, 2011
@@ -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
+
@@ -0,0 +1,23 @@
+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.

0 comments on commit 43382b7

Please sign in to comment.