Permalink
Browse files

Overhaul of how terrain is generated, leading to larger more open spa…

…ces and more flexibility.
  • Loading branch information...
1 parent 94ed04b commit cf959adcf2ee0b31afedd2a7e3b1c39ca9d28801 @clanehin committed Oct 30, 2012
View
9 Roguestar/Lib/BeginGame.hs
@@ -21,8 +21,8 @@ import Control.Monad.Random
import Roguestar.Lib.Utility.SiteCriteria
homeBiome :: Species -> WeightedSet Biome
-homeBiome RedRecreant = unweightedSet [ForestBiome,TundraBiome,MountainBiome]
-homeBiome BlueRecreant = unweightedSet [ForestBiome,TundraBiome,MountainBiome]
+homeBiome RedRecreant = weightedSet [(2,TemperateForest),(2,TemperateClearing),(1,RelaxingPond),(1,CraterInterior)]
+homeBiome BlueRecreant = weightedSet [(2,TemperateForest),(2,TemperateClearing),(1,RelaxingPond),(1,CraterInterior)]
startingEquipmentBySpecies :: Species -> [Tool]
startingEquipmentBySpecies RedRecreant = []
@@ -31,10 +31,9 @@ startingEquipmentBySpecies BlueRecreant = []
dbCreateStartingPlane :: Creature -> DB PlaneRef
dbCreateStartingPlane creature =
do seed <- getRandom
- biome <- weightedPickM $ homeBiome (creature_species creature)
dbNewPlane "belhaven" (TerrainGenerationData {
- tg_smootheness = 2,
- tg_biome = biome,
+ tg_smootheness = 3,
+ tg_biome = homeBiome (creature_species creature),
tg_placements = [recreantFactories seed] }) TheUniverse
-- |
View
1 Roguestar/Lib/Behavior.hs
@@ -69,7 +69,6 @@ facingBehavior creature_ref face =
_ | 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
logDB log_behavior INFO ("facingBehavior is: " ++ show result)
View
3 Roguestar/Lib/Behavior/Combat.hs
@@ -20,6 +20,7 @@ import Roguestar.Lib.Behavior.DeviceActivation
import Roguestar.Lib.Contact
import Roguestar.Lib.Core.Plane as Plane
import Roguestar.Lib.DetailedLocation
+import Data.List as List
data AttackModel =
RangedAttackModel CreatureRef ToolRef Device
@@ -93,7 +94,7 @@ resolveAttack attack_model face =
(ReloadSkill $ interactionMode attack_model)
(toPseudoDevice attack_model)
(attacker attack_model)
- m_defender_ref <- liftM (listToMaybe . map asChild . mapLocations) $ findContacts (contactMode $ interactionMode attack_model) (attacker attack_model) face
+ m_defender_ref <- liftM (listToMaybe . List.map asChild . mapLocations) $ findContacts (contactMode $ interactionMode attack_model) (attacker attack_model) face
case (dao_outcome_type device_activation,m_defender_ref) of
(DeviceFailed, _) | Just tool_ref <- weapon attack_model ->
return $ AttackMalfunction (attacker attack_model) tool_ref (dao_energy device_activation)
View
8 Roguestar/Lib/Behavior/Construction.hs
@@ -19,7 +19,7 @@ import Data.Maybe
-- | Modifies terrain in the specified walking direction, returning
-- True iff any terrain modification actually occured.
-modifyFacingTerrain :: (TerrainPatch -> TerrainPatch) -> Facing -> CreatureRef -> DB Bool
+modifyFacingTerrain :: (Terrain -> Terrain) -> Facing -> CreatureRef -> 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
@@ -29,9 +29,7 @@ modifyFacingTerrain f face creature_ref = liftM (fromMaybe False) $ runMaybeT $
lift $ setTerrainAt plane_ref target_position new_terrain
return True
-clearTerrain :: TerrainPatch -> TerrainPatch
-clearTerrain RockFace = Rubble
+clearTerrain :: Terrain -> Terrain
+clearTerrain RockFace = RockyGround
clearTerrain Forest = Grass
-clearTerrain DeepForest = Grass
-clearTerrain Lava = Glass
clearTerrain x = x
View
8 Roguestar/Lib/Building.hs
@@ -53,8 +53,8 @@ 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
liftM or $ lift $ forM buildings $ \(Child building_ref) ->
- do building_behavior <- buildingBehavior building_ref
- activateBuilding building_behavior creature_ref building_ref
+ do building_behavior_type <- buildingBehavior building_ref
+ activateBuilding building_behavior_type creature_ref building_ref
activateBuilding :: BuildingBehavior -> CreatureRef -> BuildingRef -> DB Bool
activateBuilding (PowerUp pud) creature_ref building_ref =
@@ -84,9 +84,9 @@ activateBuilding (OneWayStargate region) creature_ref building_ref =
-- | 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 offset creature_ref plane_ref =
+portalCreatureTo building_behavior_type offset creature_ref plane_ref =
do (all_buildings :: [BuildingRef]) <- liftM asChildren (getContents plane_ref)
- portals <- filterM (liftM ((== building_behavior) . Just) . buildingBehavior) all_buildings
+ portals <- filterM (liftM ((== building_behavior_type) . Just) . buildingBehavior) all_buildings
ideal_position <- if null portals
then liftM2 (\x y -> Position (x,y)) (getRandomR (-40,40)) (getRandomR (-40,40))
else do portal <- weightedPickM $ unweightedSet portals
View
29 Roguestar/Lib/Core/Plane.hs
@@ -14,8 +14,7 @@ module Roguestar.Lib.Core.Plane
terrainAt,
setTerrainAt,
whatIsOccupying,
- isTerrainPassable,
- getBiome)
+ isTerrainPassable)
where
import Prelude hiding (getContents)
@@ -30,7 +29,7 @@ import Roguestar.Lib.CreatureData (Creature)
import Control.Monad
import Control.Monad.Random as Random
import Data.Maybe
-import Data.List
+import Data.List as List
import Roguestar.Lib.Position as Position
import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.FactionData
@@ -144,7 +143,7 @@ getCurrentPlane = runMaybeT $
--
pickRandomClearSite :: (DBReadable db) =>
Integer -> Integer -> Integer ->
- Position -> (TerrainPatch -> Bool) -> PlaneRef ->
+ Position -> (Terrain -> Bool) -> PlaneRef ->
db Position
pickRandomClearSite search_radius
object_clear
@@ -163,18 +162,18 @@ pickRandomClearSite search_radius
pickRandomClearSite_withTimeout :: (DBReadable db) =>
Maybe Integer -> Integer -> Integer -> Integer ->
- Position -> (TerrainPatch -> Bool) -> PlaneRef ->
+ Position -> (Terrain -> Bool) -> PlaneRef ->
db (Maybe Position)
pickRandomClearSite_withTimeout (Just x) _ _ _ _ _ _ | x <= 0 = return Nothing
pickRandomClearSite_withTimeout timeout search_radius object_clear terrain_clear (Position (start_x,start_y)) terrainPredicate plane_ref =
do logDB log_plane DEBUG $ "Searching for clear site . . ."
- xys <- liftM2 (\a b -> map Position $ zip a b)
+ xys <- liftM2 (\a b -> List.map Position $ zip a b)
(mapM (\x -> liftM (+start_x) $ getRandomR (-x,x)) [1..search_radius])
(mapM (\x -> liftM (+start_y) $ getRandomR (-x,x)) [1..search_radius])
terrain <- liftM plane_terrain $ dbGetPlane plane_ref
- clutter_locations <- liftM (map identityDetail . filterLocations (\(_ :: MultiPosition) -> True)) $ getContents plane_ref
+ clutter_locations <- liftM (List.map identityDetail . filterLocations (\(_ :: MultiPosition) -> True)) $ getContents plane_ref
let terrainIsClear (Position (x,y)) =
- all terrainPredicate $
+ all terrainPredicate $ List.map (\(Terrain t) -> t) $
concat [[gridAt terrain (x',y') |
x' <- [x-terrain_clear..x+terrain_clear]] |
y' <- [y-terrain_clear..y+terrain_clear]]
@@ -193,13 +192,15 @@ pickRandomClearSite_withTimeout timeout search_radius object_clear terrain_clear
terrainPredicate
plane_ref
-terrainAt :: (DBReadable db) => PlaneRef -> Position -> db TerrainPatch
+terrainAt :: (DBReadable db) => PlaneRef -> Position -> db Terrain
terrainAt plane_ref (Position (x,y)) =
do terrain <- liftM plane_terrain $ dbGetPlane plane_ref
- return $ gridAt terrain (x,y)
+ return $ case (gridAt terrain (x,y)) of
+ Terrain t -> t
+ Biome _ -> error "terrainAt: What's this biome doing here?"
-setTerrainAt :: PlaneRef -> Position -> TerrainPatch -> DB ()
-setTerrainAt plane_ref (Position pos) patch = dbModPlane (\p -> p { plane_terrain = specificReplaceGrid pos patch $ plane_terrain p }) plane_ref
+setTerrainAt :: PlaneRef -> Position -> Terrain -> DB ()
+setTerrainAt plane_ref (Position pos) patch = dbModPlane (\p -> p { plane_terrain = specificReplaceGrid pos (Terrain patch) $ plane_terrain p }) plane_ref
-- | Lists all of the entities that are on a specific spot, not including nested entities.
-- Typically this is zero or one creatures, and zero or more tools. Might be a building.
@@ -215,7 +216,5 @@ isTerrainPassable plane_ref creature_ref position =
f = maybe False $ either (const True) (\(Child c) -> c /= creature_ref)
(critters :: [PlanarLocation]) <- liftM (filter $ f . fromLocation . toLocation) $ whatIsOccupying plane_ref position
terrain <- terrainAt plane_ref position
- return $ not (terrain `elem` [RockFace,Forest,DeepForest]) && null critters
+ return $ not (terrain `elem` impassable_terrains) && null critters
-getBiome :: (DBReadable db) => PlaneRef -> db Biome
-getBiome = liftM plane_biome . dbGetPlane
View
2 Roguestar/Lib/CreatureData.hs
@@ -95,7 +95,7 @@ data CreatureAbility =
| DamageSkill CreatureInteractionMode
| DamageReductionTrait CreatureInteractionMode
| ReloadSkill CreatureInteractionMode
- | TerrainAffinity TerrainPatch
+ | TerrainAffinity Terrain
| HideSkill
| SpotSkill
| JumpSkill
View
39 Roguestar/Lib/Grids.hs
@@ -4,6 +4,7 @@ module Roguestar.Lib.Grids
(Grid,
gridAt,
generateGrid,
+ interpolateGrid,
arbitraryReplaceGrid,
specificReplaceGrid,
Blob(ConeBlob, UnitBlob))
@@ -43,27 +44,27 @@ seededGrid n = SeededGrid n
seededLookup :: SeededGrid -> (Integer,Integer) -> Integer
seededLookup (SeededGrid n) (x,y) = blurp $
- ((x*809) `mod` max_int) +
- ((y*233) `mod` max_int) +
- (n `mod` max_int)
+ (blurp $ (x*809) `mod` max_int) +
+ (blurp $ (y*233) `mod` max_int) +
+ (blurp $ n `mod` max_int)
where max_int = toInteger (maxBound :: Int)
data Grid a = CompletelyRandomGrid {
_grid_seed :: SeededGrid,
_grid_weights :: WeightedSet a }
| InterpolatedGrid {
_grid_seed :: SeededGrid,
- _grid_interpolation_weights :: Map (a,a) (WeightedSet a),
- grid_next :: Grid a }
+ _grid_interpolation_weights :: Maybe (Map (a,a) (WeightedSet a)),
+ _grid_next :: Grid a }
| ArbitraryReplacementGrid {
_grid_seed :: SeededGrid,
_grid_sources :: [(Double,a)],
_grid_replacement_weights :: WeightedSet a,
_grid_blob :: Blob,
- grid_next :: Grid a }
+ _grid_next :: Grid a }
| SpecificPlacementGrid {
_grid_replacements :: Map (Integer,Integer) a,
- grid_next :: Grid a }
+ _grid_next :: Grid a }
| CachedGrid (StorableCachedGrid a)
deriving (Read,Show)
@@ -74,9 +75,12 @@ gridAt (InterpolatedGrid seeded interpolation_map grid) at@(x,y) =
there = gridAt grid (x `div` 2 + 1,y `div` 2 + 1)
there_x = gridAt grid (x `div` 2 + 1,y `div` 2)
there_y = gridAt grid (x `div` 2,y `div` 2 + 1)
- interpolate a1 a2 = fst $ weightedPick (interpolation_map ! (a1,a2)) (mkRNG $ seededLookup seeded at)
+ random_seed = seededLookup seeded at
+ interpolate a1 a2 = case interpolation_map of
+ Just interpolation_map' -> fst $ weightedPick (interpolation_map' ! (a1,a2)) $ mkRNG random_seed
+ Nothing -> if even random_seed then a1 else a2
in case (even x,even y) of
- (True,True) -> here
+ (True,True) -> (interpolate here here)
(True,False) -> (interpolate here there_y)
(False,True) -> (interpolate here there_x)
(False,False) -> (interpolate here there)
@@ -102,12 +106,17 @@ cachedGridOf any_other_grid = CachedGrid $ storableCachedGrid any_other_grid
-- indicates the recursion depth for the generator. The
-- Integer list is the random integer stream used to generate
-- the map.
-generateGrid :: (Ord a) => WeightedSet a -> Map (a,a) (WeightedSet a) -> Integer -> [Integer] -> Grid a
-generateGrid weights _ 0 seeds = let seed = head seeds
- in CompletelyRandomGrid (seededGrid seed) weights
-generateGrid weights interps n seeds = let seed = head seeds
- in optimizeGrid $ InterpolatedGrid (seededGrid seed) interps $
- generateGrid weights interps (n-1) (tail seeds)
+generateGrid :: (Ord a) => WeightedSet a -> Maybe (Map (a,a) (WeightedSet a)) -> Integer -> [Integer] -> Grid a
+generateGrid weights _ 0 seeds = CompletelyRandomGrid (seededGrid $ head seeds) weights
+generateGrid weights interps n seeds = interpolateGrid interps (head seeds) $
+ generateGrid weights interps (n-1) (tail seeds)
+
+-- |
+-- Interpolate the elements of a grid with intermediate elements.
+-- This "expands" the grid by a factor of 2 in each dimension.
+--
+interpolateGrid :: (Ord a) => Maybe (Map (a,a) (WeightedSet a)) -> Integer -> Grid a -> Grid a
+interpolateGrid interps seed g = optimizeGrid $ InterpolatedGrid (seededGrid seed) interps g
-- |
-- Arbitrarily (randomly) replaces some elements of a grid with another.
View
17 Roguestar/Lib/Perception.hs
@@ -21,7 +21,6 @@ module Roguestar.Lib.Perception
Roguestar.Lib.Perception.getCreatureFaction,
whereAmI,
Roguestar.Lib.Perception.whereIs,
- localBiome,
compass,
depth,
myHealth)
@@ -35,7 +34,6 @@ import Roguestar.Lib.Reference
import Roguestar.Lib.FactionData
import Roguestar.Lib.Creature as Creature
import Roguestar.Lib.PlaneVisibility
-import Roguestar.Lib.PlaneData
import Data.Maybe
import Data.List as List
import Data.Map as Map
@@ -47,15 +45,10 @@ import Roguestar.Lib.BuildingData
import Roguestar.Lib.Building
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.DetailedLocation
-import Roguestar.Lib.Building
import Roguestar.Lib.SpeciesData
-import qualified Data.ByteString.Char8 as B
import Roguestar.Lib.CreatureData
-import qualified Data.Set as Set
-import qualified Data.Map as Map
import Roguestar.Lib.Tool
import Roguestar.Lib.ToolData
-import Roguestar.Lib.PersistantData
import qualified Roguestar.Lib.DetailedTravel as DT
newtype (DBReadable db) => DBPerception db a = DBPerception { fromPerception :: (ReaderT CreatureRef db a) }
@@ -90,7 +83,7 @@ whoAmI = DBPerception $ ask
runPerception :: (DBReadable db) => CreatureRef -> (forall m. DBReadable m => DBPerception m a) -> db a
runPerception creature_ref perception = dbSimulate $ runReaderT (fromPerception perception) creature_ref
-visibleTerrain :: (DBReadable db) => DBPerception db [(Position,TerrainPatch)]
+visibleTerrain :: (DBReadable db) => DBPerception db [(Position,Terrain)]
visibleTerrain =
do plane_ref <- whatPlaneAmIOn
faction <- myFaction
@@ -146,6 +139,7 @@ convertToVisibleObjectRecord ref | (Just tool_ref) <- coerceReference ref =
convertToVisibleObjectRecord ref | (Just building_ref :: Maybe BuildingRef) <- coerceReference ref =
do location <- DT.whereIs building_ref
return $ VisibleBuilding building_ref (detail location) (detail location) (detail location)
+convertToVisibleObjectRecord _ | otherwise = error "convertToVisibleObjectRecord: Impossible case."
stackVisibleObjects :: [VisibleObject] -> Map Position [VisibleObject]
stackVisibleObjects = List.foldr insertVob Map.empty
@@ -165,7 +159,7 @@ visibleObjectPosition (VisibleBuilding { visible_building_occupies = multi_posit
visibleObjectPosition vob = toMultiPosition $ visible_object_position vob
visibleObjectSize :: VisibleObject -> Integer
-visibleObjectSize (VisibleTool { visible_tool = t } ) = 0
+visibleObjectSize (VisibleTool {} ) = 0
visibleObjectSize _ = 1000000
visibleObjects :: (DBReadable db) =>
@@ -205,11 +199,6 @@ whereIs :: (DBReadable db, ReferenceType a) =>
Reference a -> DBPerception db (DetailedLocation (Child a))
whereIs ref = liftM (fromMaybe (error "Perception.whereIs: not a child of its own location record") . fromLocation) $ liftDB $ DB.whereIs ref
-localBiome :: (DBReadable db) => DBPerception db Biome
-localBiome =
- do plane_ref <- whatPlaneAmIOn
- liftDB $ liftM plane_biome $ dbGetPlane plane_ref
-
-- Let's look into re-writing this with A*:
-- http://hackage.haskell.org/packages/archive/astar/0.2.1/doc/html/Data-Graph-AStar.html
compass :: (DBReadable db) => DBPerception db Facing
View
3 Roguestar/Lib/PlaneData.hs
@@ -5,9 +5,10 @@ module Roguestar.Lib.PlaneData
import Roguestar.Lib.TerrainData
import qualified Data.ByteString.Char8 as B
+import Roguestar.Lib.Random as Random
data Plane = Plane
- { plane_biome :: Biome,
+ { plane_biome :: WeightedSet Biome,
plane_terrain :: TerrainGrid,
plane_random_id :: Integer,
plane_planet_name :: B.ByteString }
View
15 Roguestar/Lib/PlaneVisibility.hs
@@ -14,7 +14,7 @@ import Roguestar.Lib.Core.Plane
import Roguestar.Lib.PlaneData
import Control.Monad
import Roguestar.Lib.CreatureData
-import Data.List
+import Data.List as List
import Roguestar.Lib.Grids
import Roguestar.Lib.GridRayCaster
import Roguestar.Lib.VisibilityData
@@ -34,16 +34,15 @@ dbGetSeersForFaction faction plane_ref =
-- Returns a list of all terrain patches that are visible to any creature belonging
-- to the specified faction on the specified plane.
--
-dbGetVisibleTerrainForFaction :: (DBReadable db) => Faction -> PlaneRef ->
- db [(Position,TerrainPatch)]
+dbGetVisibleTerrainForFaction :: (DBReadable db) => Faction -> PlaneRef -> db [(Position,Terrain)]
dbGetVisibleTerrainForFaction faction plane_ref =
do critters <- dbGetSeersForFaction faction plane_ref
liftM (nub . concat) $ mapRO dbGetVisibleTerrainForCreature critters
-- |
-- Returns a list of all terrain patches that are visible to the specified creature.
--
-dbGetVisibleTerrainForCreature :: (DBReadable db) => CreatureRef -> db [(Position,TerrainPatch)]
+dbGetVisibleTerrainForCreature :: (DBReadable db) => CreatureRef -> db [(Position,Terrain)]
dbGetVisibleTerrainForCreature creature_ref =
do loc <- liftM identityDetail $ getPlanarLocation creature_ref
spot_check <- dbGetSpotCheck creature_ref
@@ -86,7 +85,7 @@ dbIsPlanarVisible creature_ref obj_ref =
\(Position (cx,cy),Position (ox,oy)) ->
do let delta_at = (ox-cx,oy-cy)
terrain <- liftM plane_terrain $ dbGetPlane (planar_parent c) -- falling through all other tests, cast a ray for visibility
- return $ castRay (cx,cy) (ox,oy) (spot_check - distanceCostForSight Here delta_at) (terrainOpacity . gridAt terrain)
+ return $ castRay (cx,cy) (ox,oy) (spot_check - distanceCostForSight Here delta_at) (terrainOpacity . (\(Terrain t) -> t) . gridAt terrain)
dbGetOpposedSpotCheck :: (DBReadable db) => CreatureRef -> Reference a -> db Integer
dbGetOpposedSpotCheck creature_ref object_ref =
@@ -113,16 +112,16 @@ dbGetHideCheck _ | otherwise = return 1
-- visibleTerrain (creature's location) (spot check) (the terrain map) gives
-- a list of visible terrain patches from that location with that spot check.
--
-visibleTerrain :: Position -> Integer -> TerrainGrid -> [(Position,TerrainPatch)]
+visibleTerrain :: Position -> Integer -> TerrainGrid -> [(Position,Terrain)]
visibleTerrain (Position (creature_at@(creature_x,creature_y))) spot_check terrain =
let max_range = maximumRangeForSpotCheck spot_check
- in map (\(x,y) -> (Position (x,y),gridAt terrain (x,y))) $
+ in List.map (\(x,y) -> (Position (x,y),(\(Terrain t) -> t) $ gridAt terrain (x,y))) $
castRays creature_at
[terrainPatchBrightnessForm creature_at spot_check (creature_x+x,creature_y+y)
| x <- [-max_range..max_range],
y <- [-max_range..max_range],
x^2+y^2 <= max_range^2]
- (terrainOpacity . gridAt terrain)
+ (terrainOpacity . (\(Terrain t) -> t) . gridAt terrain)
-- |
-- terrainPatchBrightnessForm (creature's location) (spot check) (terrain patch's location)
View
83 Roguestar/Lib/PlanetData.hs
@@ -12,6 +12,7 @@ module Roguestar.Lib.PlanetData
import Roguestar.Lib.PersistantData
import Roguestar.Lib.TerrainData
import Roguestar.Lib.BuildingData
+import qualified Roguestar.Lib.Random as Random
import Data.Ratio
import qualified Data.ByteString.Char8 as B
@@ -29,38 +30,34 @@ data PlanetInfo = PlanetInfo {
planet_info_name :: Maybe B.ByteString,
-- | Number of dungeon levels on the planet.
planet_info_depth :: Integer,
- planet_info_biome :: Biome,
- planet_info_dungeon :: Biome,
+ planet_info_biome :: Random.WeightedSet Biome,
+ planet_info_dungeon :: Random.WeightedSet Biome,
planet_info_town :: [(Rational,BuildingPrototype)],
planet_info_node_type :: BuildingPrototype }
-nonaligned :: Integer -> B.ByteString -> Biome -> PlanetInfo
-nonaligned x name biome = PlanetInfo {
+nonaligned :: Integer -> B.ByteString -> PlanetInfo
+nonaligned x name = PlanetInfo {
planet_info_priority = fromInteger x / 3,
planet_info_region = NonAlignedRegion,
planet_info_name = case name of
"" -> Nothing
_ -> Just name,
planet_info_depth = x,
- planet_info_biome = biome,
- planet_info_dungeon = case () of
- () | biome == OceanBiome -> AbyssalDungeon
- () | biome == SwampBiome -> AbyssalDungeon
- () | x == 1 -> ShallowDungeon
- () -> DeepDungeon,
+ planet_info_biome = Random.unweightedSet [TemperateForest,TemperateClearing,RelaxingPond],
+ planet_info_dungeon = Random.unweightedSet [CraterInterior],
planet_info_town = [(1,basic_stargate)],
planet_info_node_type = powerup }
-cyber :: B.ByteString -> Biome -> PlanetInfo
-cyber name biome = PlanetInfo {
+cyber :: B.ByteString -> PlanetInfo
+cyber name = PlanetInfo {
planet_info_priority = 0.0,
planet_info_region = CyborgRegion,
planet_info_name = case name of
"" -> Nothing
_ -> Just name,
planet_info_depth = 5,
- planet_info_biome = biome,
- planet_info_dungeon = FrozenDungeon,
+ planet_info_biome = Random.unweightedSet [TemperateForest,TemperateClearing,RelaxingPond],
+ planet_info_dungeon = Random.unweightedSet [CraterInterior],
planet_info_town = [(1,cybergate)],
planet_info_node_type = powerup }
@@ -72,39 +69,39 @@ removeTown planet_info town = planet_info { planet_info_town = filter (\(_,build
nonaligned_first_series_planets :: [PlanetInfo]
nonaligned_first_series_planets = [
- nonaligned 1 "" RockBiome,
- nonaligned 1 "" IcyRockBiome,
- nonaligned 2 "roanoke" SwampBiome,
- nonaligned 2 "pamlico" SwampBiome,
- nonaligned 2 "pungo" ForestBiome,
- nonaligned 2 "neuse" ForestBiome,
- nonaligned 2 "crabtree" SwampBiome,
- nonaligned 2 "eno" SwampBiome `addTown` [(1%20,monolith)],
- nonaligned 2 "yadkin" SwampBiome,
- nonaligned 2 "catawba" ForestBiome,
- (nonaligned 5 "pasquotank" ForestBiome `addTown` [(1,cybergate)]) { planet_info_priority = 100.0 }]
+ nonaligned 1 "",
+ nonaligned 1 "",
+ nonaligned 2 "roanoke",
+ nonaligned 2 "pamlico",
+ nonaligned 2 "pungo",
+ nonaligned 2 "neuse",
+ nonaligned 2 "crabtree",
+ nonaligned 2 "eno" `addTown` [(1%20,monolith)],
+ nonaligned 2 "yadkin",
+ nonaligned 2 "catawba",
+ (nonaligned 5 "pasquotank" `addTown` [(1,cybergate)]) { planet_info_priority = 100.0 }]
nonaligned_second_series_planets :: [PlanetInfo]
nonaligned_second_series_planets = [
- nonaligned 1 "" TundraBiome,
- nonaligned 1 "" DesertBiome,
- nonaligned 1 "" MountainBiome,
- nonaligned 2 "dogwood" GrasslandBiome,
- nonaligned 3 "cardinal" GrasslandBiome,
- nonaligned 4 "currituck" OceanBiome,
- nonaligned 4 "hatteras" OceanBiome,
- nonaligned 4 "lookout" OceanBiome,
- nonaligned 4 "ocracoke" OceanBiome,
- (nonaligned 7 "emerald" GrasslandBiome `removeTown` [basic_stargate]) { planet_info_priority = 100.0 }]
+ nonaligned 1 "",
+ nonaligned 1 "",
+ nonaligned 1 "",
+ nonaligned 2 "dogwood",
+ nonaligned 3 "cardinal",
+ nonaligned 4 "currituck",
+ nonaligned 4 "hatteras",
+ nonaligned 4 "lookout",
+ nonaligned 4 "ocracoke",
+ (nonaligned 7 "emerald" `removeTown` [basic_stargate]) { planet_info_priority = 100.0 }]
cyborg_planets :: [PlanetInfo]
cyborg_planets = [
- cyber "" TundraBiome,
- cyber "" TundraBiome,
- cyber "" TundraBiome,
- cyber "rainwater" PolarBiome,
- cyber "spyglass" PolarBiome,
- cyber "fairview" IcyRockBiome,
- cyber "iredale" IcyRockBiome,
- (cyber "belleview" IcyRockBiome `removeTown` [cybergate]) { planet_info_priority = 100.0 }]
+ cyber "",
+ cyber "",
+ cyber "",
+ cyber "rainwater",
+ cyber "spyglass",
+ cyber "fairview",
+ cyber "iredale",
+ (cyber "belleview" `removeTown` [cybergate]) { planet_info_priority = 100.0 }]
View
16 Roguestar/Lib/Random.hs
@@ -5,6 +5,7 @@ module Roguestar.Lib.Random
weightedSet,
unweightedSet,
append,
+ Roguestar.Lib.Random.map,
fromWeightedSet,
weightedPick,
weightedPickM,
@@ -16,7 +17,7 @@ module Roguestar.Lib.Random
rationalRoll)
where
-import Data.List
+import Data.List as List
import System.Random ()
import Control.Monad.Random
import Control.Monad
@@ -32,20 +33,23 @@ data WeightedSet a = WeightedSet {
weightedSet :: [(Integer,a)] -> WeightedSet a
weightedSet [] = error "Tried to pick from an empty list."
weightedSet as = WeightedSet {
- weighted_set_total = sum $ map fst as,
+ weighted_set_total = sum $ List.map fst as,
weighted_set = Vector.fromList $ reverse $ sortBy (comparing fst) as }
unweightedSet :: [a] -> WeightedSet a
unweightedSet [] = error "Tried to pick from an empty list."
unweightedSet as = WeightedSet {
weighted_set_total = genericLength as,
- weighted_set = Vector.fromList $ map (\x -> (1,x)) as }
+ weighted_set = Vector.fromList $ List.map (\x -> (1,x)) as }
append :: WeightedSet a -> WeightedSet a -> WeightedSet a
append a b = weightedSet $ (Vector.toList $ weighted_set a) ++ (Vector.toList $ weighted_set b)
+map :: (a -> b) -> WeightedSet a -> WeightedSet b
+map f s = WeightedSet (weighted_set_total s) $ Vector.map (\(x,y) -> (x,f y)) $ weighted_set s
+
fromWeightedSet :: WeightedSet a -> [a]
-fromWeightedSet = map snd . Vector.toList . weighted_set
+fromWeightedSet = List.map snd . Vector.toList . weighted_set
-- | Pick an element of a weighted list at random. E.g. in "[(2,x),(3,y)]" "y" will be picked three times out of five while "x" will be picked 2 times out of five.
weightedPick :: (RandomGen g) => WeightedSet a -> g -> (a,g)
@@ -69,11 +73,11 @@ linearRoll n = getRandomR (0,n)
-- | fixedSumRoll using 'linearRoll', with optimizations.
-- REVISIT: this can be improved significantly, but performance doesn't seem to be a material problem so far.
fixedSumLinearRoll :: (MonadRandom m) => [Integer] -> Integer -> m [Integer]
-fixedSumLinearRoll xs a = fixedSumRoll (map (linearRoll . min a) xs) a
+fixedSumLinearRoll xs a = fixedSumRoll (List.map (linearRoll . min a) xs) a
-- | Roll a sequence of random variables, such that the sum of the result is a fixed value.
fixedSumRoll :: (MonadRandom m) => [m Integer] -> Integer -> m [Integer]
-fixedSumRoll rs a =
+fixedSumRoll rs a =
do xs <- sequence rs
case sum xs == a of
True -> return xs
View
2 Roguestar/Lib/Roguestar.hs
@@ -13,7 +13,7 @@ module Roguestar.Lib.Roguestar
getSnapshotPlayerState,
rerollStartingSpecies,
Creature(..),
- TerrainPatch(..),
+ Terrain(..),
Position(..),
Facing(..),
Roguestar.Lib.Roguestar.beginGame,
View
186 Roguestar/Lib/TerrainData.hs
@@ -1,7 +1,8 @@
--Data
module Roguestar.Lib.TerrainData
(Biome(..),
- TerrainPatch(..),
+ Terrain(..),
+ MetaTerrain(..),
TerrainGrid,
TerrainGenerationData(..),
TerrainPlacement,
@@ -18,72 +19,55 @@ import Data.List as List
import Data.Map as Map
--import Substances hiding (Water)
import Roguestar.Lib.Random as Random
+import Control.Arrow (first,second)
-- |
--- Most automatically generated surface maps belong to a Biome, representing the kind of terrain
--- and plant life that dwells in terrain generated for the map.
+-- Biomes represent terrain phenomenon. A terrain map will interpolate between biomes.
--
-data Biome = ShallowDungeon
- | DeepDungeon
- | FrozenDungeon
- | AbyssalDungeon
- | InfernalDungeon
- | RockBiome
- | IcyRockBiome
- | GrasslandBiome
- | ForestBiome
- | TundraBiome
- | DesertBiome
- | OceanBiome
- | MountainBiome
- | SwampBiome
- | PolarBiome
+data Biome = TemperateForest
+ | TemperateClearing
+ | RelaxingPond
+ | CraterInterior
deriving (Read,Show,Eq,Ord,Enum,Bounded)
-- |
--- All static terrain elements are members of TerrainGrid
+-- Specific terrain 'squares' out of which the terrain map is constructed.
--
--- The only difference between "Deasert" and "Sand" is that where
--- "Deasert" and "Water" touch, the map generator will produce
--- patches of plantlife (for oasis and shoreline effect).
---
-data TerrainPatch = RockFace
- | Rubble
- | Ore
- | RockyGround
- | Dirt
- | Grass
- | Sand
- | Desert -- exactly like sand, except from the terrain generator's point of view: oasis can appear
- | Forest
- | DeepForest
- | Water
- | DeepWater
- | Ice
- | Lava
- | Glass -- what sand becomes when struck by intense heat
- | RecreantFactory
- | Upstairs
- | Downstairs
- deriving (Read,Show,Eq,Ord)
+data Terrain = RockFace
+ | RockyGround
+ | Dirt
+ | Grass
+ | Sand
+ | Forest
+ | Water
+ | Ice
+ | Lava
+ | Glass -- solidified lava
+ | RecreantFactory
+ | Upstairs
+ | Downstairs
+ deriving (Read,Show,Eq,Ord,Enum,Bounded)
+
+data MetaTerrain = Biome Biome | Terrain Terrain
+ deriving (Read,Show,Eq,Ord)
data TerrainGenerationData = TerrainGenerationData
{ tg_smootheness :: Integer,
- tg_biome :: Biome,
+ tg_biome :: WeightedSet Biome,
tg_placements :: [TerrainPlacement] }
deriving (Read,Show)
data TerrainPlacement = TerrainPlacement {
- placement_sources :: [(Double,TerrainPatch)],
- placement_replacements :: WeightedSet TerrainPatch,
+ placement_sources :: [(Double,Terrain)],
+ placement_replacements :: WeightedSet Terrain,
placement_seed :: Integer,
placement_blob :: Blob }
deriving (Read,Show)
placeTerrain :: TerrainPlacement -> TerrainGrid -> TerrainGrid
placeTerrain terrain_placement =
- arbitraryReplaceGrid (placement_sources terrain_placement)
- (placement_replacements terrain_placement)
+ arbitraryReplaceGrid (List.map (second Terrain) $ placement_sources terrain_placement)
+ (Random.map Terrain $ placement_replacements terrain_placement)
(placement_seed terrain_placement)
(placement_blob terrain_placement)
@@ -92,10 +76,9 @@ recreantFactories seed = TerrainPlacement {
placement_sources =
[(1/2,Ice),
(1/10,Sand),
- (1/2,Desert),
(1/5,Dirt),
(1/1,Glass),
- (1/20,Grass),
+ (1/10,Grass),
(1/100,Forest),
(1/2,RockyGround)],
placement_replacements =
@@ -132,95 +115,42 @@ stairsDown seed depth = TerrainPlacement {
-- A list of TerrainPatches that are considered "difficult", either for traveling
-- or for constructing buildings.
--
-difficult_terrains :: [TerrainPatch]
-difficult_terrains = impassable_terrains ++
- [Water,DeepWater,Ice,Lava]
+difficult_terrains :: [Terrain]
+difficult_terrains = impassable_terrains ++ [Water,Lava]
-- |
-- A list of TerrainPatches that are considered "impassable" for traveling.
--
-impassable_terrains :: [TerrainPatch]
-impassable_terrains = [RockFace,Forest,DeepForest]
-
-terrainFrequencies :: Biome -> WeightedSet TerrainPatch
-terrainFrequencies ShallowDungeon =
- weightedSet [(40,RockFace),(50,RockyGround),(5,Sand),(5,Dirt)]
-terrainFrequencies DeepDungeon =
- weightedSet [(50,RockFace),(25,Rubble),(25,RockyGround)]
-terrainFrequencies FrozenDungeon =
- weightedSet [(75,RockFace),(5,Rubble),(10,RockyGround),(10,Ice)]
-terrainFrequencies AbyssalDungeon =
- weightedSet [(60,RockFace),(10,Rubble),(10,RockyGround),(20,Water)]
-terrainFrequencies InfernalDungeon =
- weightedSet [(70,RockFace),(15,Rubble),(15,Lava)]
-terrainFrequencies RockBiome =
- weightedSet [(15,RockFace),(15,Rubble),(55,RockyGround),(15,Sand)]
-terrainFrequencies IcyRockBiome =
- weightedSet [(10,RockFace),(10,Rubble),(20,RockyGround),(60,Ice)]
-terrainFrequencies GrasslandBiome =
- weightedSet [(5,RockFace),(5,RockyGround),(10,Dirt),(10,Sand),(10,Forest),(10,Water),(50,Grass)]
-terrainFrequencies ForestBiome =
- weightedSet [(10,RockFace),(10,RockyGround),(10,Dirt),(10,Water),(10,Grass),(25,Forest),(25,DeepForest)]
-terrainFrequencies TundraBiome =
- weightedSet [(10,RockFace),(10,RockyGround),(10,Sand),(10,Water),(60,Ice)]
-terrainFrequencies DesertBiome =
- weightedSet [(10,RockFace),(10,RockyGround),(9,Grass),(1,Water),(70,Desert)]
-terrainFrequencies OceanBiome =
- weightedSet [(5,RockyGround),(10,Sand),(5,Grass),(5,Forest),(25,Water),(50,DeepWater)]
-terrainFrequencies MountainBiome =
- weightedSet [(50,RockFace),(25,RockyGround),(5,Rubble),(5,Sand),(5,Grass),(5,Forest),(5,Water)]
-terrainFrequencies SwampBiome =
- weightedSet [(40,Forest),(50,Water),(5,Sand),(5,Grass)]
-terrainFrequencies PolarBiome =
- weightedSet [(40,Ice),(30,Water),(5,DeepWater),(4,RockyGround),(1,RockFace)]
-
-terrainInterpFn :: (TerrainPatch,TerrainPatch) -> WeightedSet TerrainPatch
-terrainInterpFn (a,b) = weightedSet [(1,a),(1,b)] `Random.append` terrainInterpRule (a,b) `Random.append` terrainInterpRule (b,a)
-
--- Notice, in terrainInterpFn, we always throw in both terrain patches with a weight of 1.
-terrainInterpRule :: (TerrainPatch,TerrainPatch) -> WeightedSet TerrainPatch
-terrainInterpRule (RockFace,RockFace) = unweightedSet [RockFace]
-terrainInterpRule (RockFace,RockyGround) = weightedSet [(3,RockFace),(1,Rubble),(3,RockyGround)]
-terrainInterpRule (RockFace,x) = weightedSet [(3,RockFace),(2,Rubble),(1,RockyGround),(1,Sand),(7,x)]
-terrainInterpRule (Rubble,x) = weightedSet [(1,Rubble),(2,Sand),(2,Dirt),(5,x)]
-terrainInterpRule (DeepWater,DeepWater) = unweightedSet [DeepWater]
-terrainInterpRule (DeepWater,Water) = weightedSet [(3,DeepWater)]
-terrainInterpRule (DeepWater,_) = weightedSet [(3,Water)]
-terrainInterpRule (DeepForest,DeepForest) = weightedSet [(1,Grass)]
-terrainInterpRule (DeepForest,Forest) = weightedSet [(2,Grass)]
-terrainInterpRule (DeepForest,_) = weightedSet [(1,Forest)]
-terrainInterpRule (Forest,DeepForest) = unweightedSet [Forest,DeepForest]
-terrainInterpRule (Forest,Forest) = weightedSet [(3,Grass)]
-terrainInterpRule (Forest,_) = weightedSet [(3,Grass)]
-terrainInterpRule (Water,Water) = weightedSet [(20,Water),(1,Sand)]
-terrainInterpRule (Water,DeepWater) = unweightedSet [Water,DeepWater]
-terrainInterpRule (Water,_) = weightedSet [(1,Sand)]
-terrainInterpRule (Sand,Desert) = weightedSet [(1,Grass),(1,Forest)]
-terrainInterpRule (a,b) = unweightedSet [a,b]
-
--- |
--- A list of every TerrainPatch that might be created from the terrainFrequencies function.
---
-baseTerrainPatches :: [TerrainPatch]
-baseTerrainPatches = nub $ concatMap (fromWeightedSet . terrainFrequencies) [minBound..maxBound]
-
-terrainInterpMap :: Map (TerrainPatch,TerrainPatch) (WeightedSet TerrainPatch)
-terrainInterpMap = let terrain_patch_pairs = [(a,b) | a <- baseTerrainPatches, b <- baseTerrainPatches]
- interps = List.map terrainInterpFn terrain_patch_pairs
- in fromList (zip terrain_patch_pairs interps)
-
-type TerrainGrid = Grid TerrainPatch
+impassable_terrains :: [Terrain]
+impassable_terrains = [RockFace,Forest]
+
+terrainInterpFn :: (Biome,Biome) -> WeightedSet Terrain
+terrainInterpFn biomes = case biomes of
+ (TemperateForest,_) -> weightedSet [(2,Forest),(1,Grass),(1,Dirt)]
+ (TemperateClearing,_) -> weightedSet [(5,Grass),(3,Dirt)]
+ (RelaxingPond,RelaxingPond) -> weightedSet [(10,Water),(1,RockyGround)]
+ (RelaxingPond,_) -> weightedSet [(2,Water),(1,Sand)]
+ (CraterInterior,CraterInterior) -> weightedSet [(1,RockyGround)]
+ (CraterInterior,_) -> weightedSet [(1,RockFace)]
+
+terrainInterpMap :: Map (MetaTerrain,MetaTerrain) (WeightedSet MetaTerrain)
+terrainInterpMap =
+ let biome_patch_pairs :: [(Biome,Biome)]
+ biome_patch_pairs = [(a,b) | a <- [minBound..maxBound], b <- [minBound..maxBound]]
+ interps = List.map (Random.map Terrain . terrainInterpFn) biome_patch_pairs
+ in fromList (zip (List.map (first Biome . second Biome) biome_patch_pairs) interps)
+
+type TerrainGrid = Grid MetaTerrain
-- |
-- Generates a random terrain map. The Biome indicates determines what TerrainPatches
-- are generated. The second parameter is an Integer that indicates the smootheness of the
--- generated terrain. Finally, a random Integer stream is needed to provide the random data
+-- generated terrain. Finally, a random Integer stream is needed to provide the random data
-- to generate the terrain.
--
generateTerrain :: TerrainGenerationData -> [Integer] -> TerrainGrid
generateTerrain tg rands = flip (List.foldr placeTerrain) (tg_placements tg) $
- generateGrid (terrainFrequencies (tg_biome tg))
- terrainInterpMap
- (tg_smootheness tg)
- rands
+ interpolateGrid Nothing (head rands) $
+ interpolateGrid (Just terrainInterpMap) (head $ drop 1 rands) $
+ generateGrid (Random.map Biome $ tg_biome tg) Nothing (tg_smootheness tg) (drop 2 rands)
View
6 Roguestar/Lib/Tool.hs
@@ -59,18 +59,18 @@ availablePickups :: (DBReadable db) => CreatureRef -> db [ToolRef]
availablePickups creature_ref =
do (Parent plane_ref :: Parent Plane, creature_position :: Position) <- liftM detail $ getPlanarLocation creature_ref
pickups <- liftM (mapLocations . filterLocations (==creature_position)) $ getContents plane_ref
- return $ map (asChild . identityDetail) pickups
+ return $ List.map (asChild . identityDetail) pickups
-- | List of tools that the specified creature may choose to wield.
-- That is, they are either on the ground or in the creature's inventory.
availableWields :: (DBReadable db) => CreatureRef -> db [ToolRef]
availableWields creature_ref =
- do carried_tools :: [ToolRef] <- liftM (map (asChild . identityDetail) . mapLocations) $ getContents creature_ref
+ do carried_tools :: [ToolRef] <- liftM (List.map (asChild . identityDetail) . mapLocations) $ getContents creature_ref
pickups <- availablePickups creature_ref
return $ List.union carried_tools pickups
getWielded :: (DBReadable db) => CreatureRef -> db (Maybe ToolRef)
-getWielded = liftM (listToMaybe . map (asChild . detail) . filterLocations (\(Wielded {}) -> True)) . getContents
+getWielded = liftM (listToMaybe . List.map (asChild . detail) . filterLocations (\(Wielded {}) -> True)) . getContents
-- | Safely delete tools.
deleteTool :: ToolRef -> DB ()
View
3 Roguestar/Lib/Town.hs
@@ -6,11 +6,12 @@ module Roguestar.Lib.Town
import Roguestar.Lib.BuildingData
import Roguestar.Lib.DB
import Roguestar.Lib.Utility.SiteCriteria
+import Data.List as List
-- | Create a town from a list of buildings.
createTown :: PlaneRef -> [BuildingPrototype] -> DB [BuildingRef]
createTown plane_ref = mapM $ \building_prototype ->
- do let clear_need = minimum $ map abs $ uncurry (++) $ unzip $ buildingOccupies $ buildingproto_shape building_prototype
+ do let clear_need = maximum $ List.map abs $ uncurry (++) $ unzip $ buildingOccupies $ buildingproto_shape building_prototype
p <- pickRandomSite (-100,100) (-100,100) 100 [areaClearForObjectPlacement clear_need, closeTo $ Position (0,0)] plane_ref
let the_building = Building {
building_behavior = buildingproto_behavior building_prototype,
View
11 Roguestar/Lib/Turns.hs
@@ -26,6 +26,7 @@ import Roguestar.Lib.Data.PlayerState
import Roguestar.Lib.Logging
import Roguestar.Lib.DetailedLocation
import Control.Monad.Random
+import Data.List as List
dbPerformPlayerTurn :: Behavior -> CreatureRef -> DB ()
dbPerformPlayerTurn beh creature_ref =
@@ -48,7 +49,7 @@ dbFinishPlanarAITurns plane_ref =
sweepDead plane_ref
(all_creatures_on_plane :: [CreatureRef]) <- liftM asChildren $ getContents plane_ref
any_players_left <- liftM (any (== Player)) $ mapM getCreatureFaction all_creatures_on_plane
- next_turn <- dbNextTurn $ map genericReference all_creatures_on_plane ++ [genericReference plane_ref]
+ next_turn <- dbNextTurn $ List.map genericReference all_creatures_on_plane ++ [genericReference plane_ref]
case next_turn of
_ | not any_players_left ->
do logDB log_turns INFO $ "dbFinishPlanarAITurns; Game over condition detected"
@@ -69,7 +70,7 @@ dbFinishPlanarAITurns plane_ref =
planar_turn_frequency :: Integer
planar_turn_frequency = 100
-monster_spawns :: [(TerrainPatch,Species)]
+monster_spawns :: [(Terrain,Species)]
monster_spawns = [(RecreantFactory,RedRecreant)]
dbPerform1PlanarAITurn :: PlaneRef -> DB ()
@@ -80,15 +81,15 @@ dbPerform1PlanarAITurn plane_ref =
num_npcs <- liftM length $ filterRO (liftM (/= Player) . getCreatureFaction . asChild . detail) creature_locations
when (num_npcs < length player_locations * 3) $
do (terrain_type,species) <- weightedPickM $ unweightedSet monster_spawns
- _ <- spawnNPC terrain_type species plane_ref $ map detail $ player_locations
+ _ <- spawnNPC terrain_type species plane_ref $ List.map detail $ player_locations
return ()
dbAdvanceTime plane_ref (1%planar_turn_frequency)
-- |
-- Spawn a non-player creature on the specified terrain type (or fail if not finding that terrain type)
-- and of the specified species, on the specified plane, near one of the specified positions
-- (presumably the list of positions of all player characters).
-spawnNPC :: TerrainPatch -> Species -> PlaneRef -> [Position] -> DB Bool
+spawnNPC :: Terrain -> Species -> PlaneRef -> [Position] -> DB Bool
spawnNPC terrain_type species plane_ref player_locations =
do logDB log_turns INFO $ "spawnNPC; Spawning an NPC"
p <- weightedPickM $ unweightedSet player_locations
@@ -109,7 +110,7 @@ dbPerform1CreatureAITurn creature_ref =
do f <- P.getCreatureFaction might_be_the_player_creature_ref
return $ f == Player
isPlayer _ | otherwise = return False
- (visible_player_locations :: [Position]) <- lift $ liftM (map P.visible_object_position) $ P.visibleObjects isPlayer
+ (visible_player_locations :: [Position]) <- lift $ liftM (List.map P.visible_object_position) $ P.visibleObjects isPlayer
-- FIXME: what if there is more than one player
player_position <- MaybeT $ return $ listToMaybe visible_player_locations
(rand_x :: Integer) <- lift $ getRandomR (1,100)
View
4 Roguestar/Lib/UnitTests.hs
@@ -14,7 +14,7 @@ import Control.Monad.Reader.Class
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.TerrainData
import Roguestar.Lib.Utility.SiteCriteria
-import Control.Monad.Random
+import Roguestar.Lib.Random as Random
type UnitTest = WriterT (T.Text,All) IO ()
@@ -55,7 +55,7 @@ runWithRandomPlanes n test_name db_action = forM_ [1..n] $ \x ->
runWithRandomPlane_ :: (PlaneRef -> DB Bool) -> DB Bool
runWithRandomPlane_ dbAction =
- do biome <- weightedPickM $ unweightedSet [minBound..maxBound]
+ do let biome = Random.weightedSet [(4,TemperateClearing),(1,TemperateForest)]
plane_ref <- dbNewPlane "testPlane" (TerrainGenerationData 3 biome []) TheUniverse
dbAction plane_ref
View
4 Roguestar/Lib/Utility/SiteCriteria.hs
@@ -25,7 +25,7 @@ class SiteCriteria a where
data SimpleSiteCriteria =
TerrainClear { _terrain_clear_radius :: Integer,
- _terrain_clear_test :: TerrainPatch -> Bool } |
+ _terrain_clear_test :: Terrain -> Bool } |
ObjectClear { _object_clear_radius :: Integer } |
AtDistanceFrom { _at_distance_from_center :: Position,
_at_distance :: Integer } |
@@ -60,7 +60,7 @@ areaClearForObjectPlacement :: Integer -> SimpleSiteCriteria
areaClearForObjectPlacement radius = RequireAtLeast 0.999 $ [TerrainClear radius (not . (`elem` difficult_terrains)), ObjectClear radius]
-- SiteCriteria that requires the found site to exactly match the specified type of terrain patch.
-onTerrainType :: TerrainPatch -> SimpleSiteCriteria
+onTerrainType :: Terrain -> SimpleSiteCriteria
onTerrainType terrain = RequireAtLeast 0 $ TerrainClear 0 (== terrain)
-- SiteCriteria that tries to get as close to the specified position as possible.
View
16 Roguestar/Lib/VisibilityData.hs
@@ -13,19 +13,14 @@ import Roguestar.Lib.Facing
-- |
-- We multiply a creature's hide check by this number if it is standing on this terrain.
--
-terrainHideMultiplier :: TerrainPatch -> Integer
+terrainHideMultiplier :: Terrain -> Integer
terrainHideMultiplier RockFace = 3
-terrainHideMultiplier Rubble = 2
-terrainHideMultiplier (Ore {}) = 2
terrainHideMultiplier RockyGround = 1
terrainHideMultiplier Dirt = 0
terrainHideMultiplier Grass = 1
terrainHideMultiplier Sand = 1
-terrainHideMultiplier Desert = 1
terrainHideMultiplier Forest = 2
-terrainHideMultiplier DeepForest = 2
terrainHideMultiplier Water = 2
-terrainHideMultiplier DeepWater = 2
terrainHideMultiplier Ice = 0
terrainHideMultiplier Lava = 0 -- you definitely can't hide on lava
terrainHideMultiplier Glass = 0
@@ -37,21 +32,16 @@ terrainHideMultiplier Upstairs = 0
-- We cast a ray between the spotter and the hider. This indicates to what extent each terrain type
-- interferes with vision.
--
-terrainOpacity :: TerrainPatch -> Integer
+terrainOpacity :: Terrain -> Integer
terrainOpacity RockFace = 90
-terrainOpacity Rubble = 10
-terrainOpacity (Ore {}) = 10
terrainOpacity RockyGround = 0
terrainOpacity Dirt = 0
terrainOpacity Grass = 5
terrainOpacity Sand = 0
-terrainOpacity Desert = 0
terrainOpacity Forest = 25
-terrainOpacity DeepForest = 50
terrainOpacity Water = 0
-terrainOpacity DeepWater = 0
terrainOpacity Ice = 0
-terrainOpacity Lava = 0
+terrainOpacity Lava = 10 -- lava makes smoke/heat distoration? Makes sense.
terrainOpacity Glass = 0
terrainOpacity RecreantFactory = 0
terrainOpacity Downstairs = 0
View
9 Roguestar/Server/Main.hs
@@ -380,7 +380,7 @@ getGame =
Nothing -> redirect "/start"
data MapData = MapData {
- md_visible_terrain :: Map.Map Position TerrainPatch,
+ md_visible_terrain :: Map.Map Position Terrain,
md_visible_objects :: Map.Map Position [VisibleObject],
md_position_info :: (Facing,Position) }
@@ -494,19 +494,14 @@ instance Charcoded Species where
codedRepresentation _ RedRecreant = ('r',Strong)
codedRepresentation _ BlueRecreant = ('@',Strong)
-instance Charcoded TerrainPatch where
+instance Charcoded Terrain where
codedRepresentation _ RockFace = ('#',Rocky)
- codedRepresentation _ Rubble = ('.',Rocky)
- codedRepresentation _ Ore = ('.',Rocky)
codedRepresentation _ RockyGround = ('.',Rocky)
codedRepresentation _ Dirt = ('.',Dusty)
codedRepresentation _ Grass = ('.',Plants)
codedRepresentation _ Sand = ('.',Sandy)
- codedRepresentation _ Desert = ('.',Sandy)
codedRepresentation _ Forest = ('f',Plants)
- codedRepresentation _ DeepForest = ('f',Plants)
codedRepresentation _ TerrainData.Water = ('~',Wet)
- codedRepresentation _ DeepWater = ('~',Gloomy)
codedRepresentation _ Ice = ('.',Icy)
codedRepresentation _ Lava = ('~',Molten)
codedRepresentation _ Glass = ('.',Gloomy)

0 comments on commit cf959ad

Please sign in to comment.