Permalink
Browse files

Major restructuring of the location system, which doesn't seem to be …

…utterly broken.
  • Loading branch information...
1 parent 4bf7970 commit 045473d0e7a6947dbb5e4f6becea9b790888fea2 @clanehin committed Apr 1, 2012
View
2 README
@@ -12,6 +12,8 @@ The binary packages:
And the library packages:
* rsagl (RogueStar Animation and Graphics Library)
+* rsagl-math
+* rsagl-frp
The library packages must be installed before the binary packages can
even be configured.
@@ -23,7 +23,7 @@ executable roguestar-engine
mtl >=1.1.0.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, base >=4 && <5
- other-modules: TravelData, VisibilityData, FactionData, Behavior, Alignment, PlaneData, Grids, Perception, PlaneVisibility, Turns, Plane, CreatureData, Protocol, Character, Tool, Substances, HierarchicalDatabase, Travel, ToolData, CharacterData, Creature, Facing, DBPrivate, RNG, Species, Position, TerrainData, Combat, Tests, DBData, GridRayCaster, BeginGame, SpeciesData, TimeCoordinate, DB, AttributeGeneration, CreatureAttribute, Building, BuildingData, Town, Random, PlayerState, MakeData, DBErrorFlag, Construction, Make, Activate, Contact, DeviceActivation, WorkCluster, Planet, PlanetData, Logging, NodeData, CharacterAdvancement
+ other-modules: TravelData, VisibilityData, FactionData, Behavior, Alignment, PlaneData, Grids, Perception, PlaneVisibility, Turns, Plane, CreatureData, Protocol, Character, Tool, Substances, HierarchicalDatabase, Travel, ToolData, CharacterData, Creature, Facing, DBPrivate, RNG, Species, Position, TerrainData, Combat, Tests, DBData, GridRayCaster, BeginGame, SpeciesData, TimeCoordinate, DB, AttributeGeneration, CreatureAttribute, Building, BuildingData, Town, Random, PlayerState, MakeData, DBErrorFlag, Construction, Make, Activate, Contact, DeviceActivation, WorkCluster, Planet, PlanetData, Logging, PowerUpData, CharacterAdvancement, PersistantData
ghc-prof-options: -prof -auto-all
ghc-shared-options: -prof -auto-all
if impl(ghc >= 7.0)
@@ -19,7 +19,7 @@ data ActivationOutcome =
resolveActivation :: (DBReadable db) => CreatureRef -> db ActivationOutcome
resolveActivation creature_ref =
- do tool_ref <- maybe (throwError $ DBErrorFlag NoToolWielded) return =<< dbGetWielded creature_ref
+ do tool_ref <- maybe (throwError $ DBErrorFlag NoToolWielded) return =<< getWielded creature_ref
tool <- dbGetTool tool_ref
case tool of
DeviceTool {} -> throwError $ DBErrorFlag ToolIs_Innapropriate
@@ -77,19 +77,19 @@ dbCreateStartingPlane creature =
-- The character class should not be pre-applied to the creature.
--
dbBeginGame :: Creature -> CharacterClass -> DB ()
-dbBeginGame creature character_class =
+dbBeginGame creature character_class =
do let first_level_creature = applyCharacterClass character_class creature
plane_ref <- dbCreateStartingPlane creature
landing_site <- pickRandomClearSite 200 30 2 (Position (0,0)) (not . (`elem` difficult_terrains)) plane_ref
creature_ref <- dbAddCreature first_level_creature (Standing plane_ref landing_site Here)
- _ <- createTown plane_ref [Stargate Portal,Node Monolith]
+ _ <- createTown plane_ref [basic_stargate,monolith]
let starting_equip = startingEquipmentBySpecies (creature_species creature) ++ startingEquipmentByClass character_class
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 Portal) =<< generatePlanetInfo nonaligned_first_series_planets
- _ <- makePlanets (Subsequent end_of_nonaligned_first_series Portal) =<< generatePlanetInfo nonaligned_second_series_planets
- _ <- makePlanets (Subsequent end_of_nonaligned_first_series CyberGate) =<< 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 NormalMode
@@ -6,11 +6,13 @@ module Behavior
dbBehave)
where
+import Prelude hiding (getContents)
import DB
import Position
import Facing
import Data.Ratio
import Tool
+import ToolData
import Control.Monad.Error
import Combat
import Activate
@@ -26,6 +28,10 @@ import TerrainData
import Make
import Construction
import Building
+import Reference
+import DetailedLocation
+import Plane
+import PlaneData
--
-- Every possible behavior that a creature might take, AI or Human.
@@ -55,25 +61,22 @@ data Behavior =
-- 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 parent) $ 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 $ ClearTerrain face
- DeepForest -> return $ ClearTerrain face
- RockFace -> return $ ClearTerrain face
- _ -> return $ Step 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
+ what :: [BuildingRef] <- liftM asChildren $ whatIsOccupying plane_ref facing_pos
+ case t of
+ _ | not (null who) -> return $ Attack face
+ _ | not (null what) -> return $ ActivateBuilding face
+ Forest -> return $ ClearTerrain face
+ DeepForest -> return $ ClearTerrain face
+ RockFace -> return $ ClearTerrain face
+ _ -> return $ Step face
dbBehave :: Behavior -> CreatureRef -> DB ()
dbBehave (Step face) creature_ref =
- do (move_from,move_to) <- dbMove (stepCreature face) creature_ref
+ do (move_from,move_to) <- move creature_ref =<< 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
@@ -95,18 +98,18 @@ dbBehave (Jump face) creature_ref =
dbAdvanceTime creature_ref =<< fullActionTime creature_ref
dbBehave (TurnInPlace face) creature_ref =
- do _ <- dbMove (turnCreature face) creature_ref
+ do _ <- move creature_ref =<< turnCreature face creature_ref
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
dbBehave (Pickup tool_ref) creature_ref =
- do _ <- dbMove (dbPickupTool creature_ref) tool_ref
+ do _ <- move tool_ref =<< pickupTool 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
+ already_wielded <- getWielded creature_ref
when (not $ tool_ref `elem` available) $ throwError $ DBErrorFlag ToolIs_Unreachable
- _ <- dbMove dbWieldTool tool_ref
+ _ <- move tool_ref =<< wieldTool 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
@@ -116,40 +119,38 @@ dbBehave (Unwield) creature_ref =
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
dbBehave (Drop tool_ref) creature_ref =
- do tool_parent <- liftM extractParent $ dbWhere tool_ref
- already_wielded <- dbGetWielded creature_ref
- when (tool_parent /= Just creature_ref) $ throwError $ DBErrorFlag ToolIs_NotInInventory
- _ <- dbMove dbDropTool tool_ref
+ do tool_parent <- liftM parentReference $ whereIs tool_ref
+ already_wielded <- getWielded creature_ref
+ when (tool_parent =/= creature_ref) $ throwError $ DBErrorFlag ToolIs_NotInInventory
+ _ <- move tool_ref =<< dropTool 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
+ do _ <- move creature_ref =<< turnCreature face creature_ref
ranged_attack_model <- rangedAttackModel creature_ref
_ <- atomic executeAttack $ resolveAttack ranged_attack_model face
dbAdvanceTime creature_ref =<< quickActionTime creature_ref
return ()
dbBehave (Attack face) creature_ref =
- do _ <- dbMove (turnCreature 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
return ()
dbBehave Wait creature_ref = dbAdvanceTime creature_ref =<< quickActionTime creature_ref
-dbBehave Vanish creature_ref =
+dbBehave Vanish creature_ref =
do dbAdvanceTime creature_ref =<< quickActionTime creature_ref
- _ <- runMaybeT $
- do (plane_ref :: PlaneRef) <- MaybeT $ liftM (fmap parent) $ 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
+ (Parent plane_ref :: Parent Plane) <- liftM detail $ getPlanarLocation creature_ref
+ faction <- getCreatureFaction 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
return ()
dbBehave Activate creature_ref =
@@ -163,14 +164,14 @@ dbBehave (Make make_prep) creature_ref =
return ()
dbBehave (ClearTerrain face) creature_ref =
- do _ <- dbMove (turnCreature 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
return ()
dbBehave (ActivateBuilding face) creature_ref =
- do _ <- dbMove (turnCreature 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
@@ -182,7 +183,7 @@ dbBehave (ActivateBuilding face) creature_ref =
-- | 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 (asType _tool)) $ dbGetContents 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
Oops, something went wrong.

0 comments on commit 045473d

Please sign in to comment.