Overhaul of how terrain is generated, leading to larger more open spaces and more flexibility.

parent 94ed04b2
......@@ -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
-- |
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......@@ -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
......
......@@ -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
......@@ -95,7 +95,7 @@ data CreatureAbility =
| DamageSkill CreatureInteractionMode
| DamageReductionTrait CreatureInteractionMode
| ReloadSkill CreatureInteractionMode
| TerrainAffinity TerrainPatch
| TerrainAffinity Terrain
| HideSkill
| SpotSkill
| JumpSkill
......
......@@ -4,6 +4,7 @@ module Roguestar.Lib.Grids
(Grid,
gridAt,
generateGrid,
interpolateGrid,
arbitraryReplaceGrid,
specificReplaceGrid,
Blob(ConeBlob, UnitBlob))
......@@ -43,9 +44,9 @@ 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 {
......@@ -53,17 +54,17 @@ data Grid a = CompletelyRandomGrid {
_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.
......
......@@ -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
......
......@@ -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 }
......
......@@ -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,8 +34,7 @@ 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
......@@ -43,7 +42,7 @@ dbGetVisibleTerrainForFaction faction plane_ref =
-- |
-- 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)
......
......@@ -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 }]
......@@ -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
......
......@@ -13,7 +13,7 @@ module Roguestar.Lib.Roguestar
getSnapshotPlayerState,
rerollStartingSpecies,
Creature(..),
TerrainPatch(..),
Terrain(..),
Position(..),
Facing(..),
Roguestar.Lib.Roguestar.beginGame,
......
This diff is collapsed.
......@@ -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 ()
......
......@@ -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,
......
......@@ -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,7 +81,7 @@ 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)
......@@ -88,7 +89,7 @@ dbPerform1PlanarAITurn plane_ref =
-- 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)
......
......@@ -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