Various changes made while sleep deprived. I think this adds mwc-random, a...

Various changes made while sleep deprived.  I think this adds mwc-random, a new random site picker with pluggable criteria, and a few css improvements including images.
parent 8e5142ab
-- Mechanics
module Roguestar.Lib.Activate
(ActivationOutcome,
resolveActivation,
......
-- Data
module Roguestar.Lib.Alignment
(Alignment,
MoralAlignment(..),
......
......@@ -3,9 +3,9 @@ module Roguestar.Lib.BeginGame
(beginGame)
where
import Roguestar.Lib.Plane
-- World
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.CreatureData
import Roguestar.Lib.Character
import Roguestar.Lib.BuildingData
import Roguestar.Lib.DB
import Roguestar.Lib.Facing
......@@ -14,17 +14,15 @@ import Roguestar.Lib.ToolData
import Control.Monad
import Control.Monad.Error
import Roguestar.Lib.SpeciesData
import Roguestar.Lib.Substances as Substances
import Roguestar.Lib.PlayerState
import Roguestar.Lib.Town
import Roguestar.Lib.PlanetData
import Roguestar.Lib.Planet
import qualified Data.ByteString.Char8 as B ()
import Control.Monad.Random
import Roguestar.Lib.Utility.SiteCriteria
homeBiome :: Species -> [Biome]
homeBiome RedRecreant = [ForestBiome,TundraBiome,MountainBiome]
homeBiome BlueRecreant = [ForestBiome,TundraBiome,MountainBiome]
homeBiome :: Species -> WeightedSet Biome
homeBiome RedRecreant = unweightedSet [ForestBiome,TundraBiome,MountainBiome]
homeBiome BlueRecreant = unweightedSet [ForestBiome,TundraBiome,MountainBiome]
startingEquipmentBySpecies :: Species -> [Tool]
startingEquipmentBySpecies RedRecreant = []
......@@ -33,7 +31,7 @@ startingEquipmentBySpecies BlueRecreant = []
dbCreateStartingPlane :: Creature -> DB PlaneRef
dbCreateStartingPlane creature =
do seed <- getRandom
biome <- pickM $ homeBiome (creature_species creature)
biome <- weightedPickM $ homeBiome (creature_species creature)
dbNewPlane "belhaven" (TerrainGenerationData {
tg_smootheness = 2,
tg_biome = biome,
......@@ -49,7 +47,7 @@ beginGame =
SpeciesSelectionState (Just c) -> return c
_ -> throwError $ DBError "Tried to begin a game, but no species/creature has been selected."
plane_ref <- dbCreateStartingPlane creature
landing_site <- pickRandomClearSite 200 30 2 (Position (0,0)) (not . (`elem` difficult_terrains)) plane_ref
landing_site <- pickRandomSite (-150,150) (-150,150) 150 [areaClearForObjectPlacement 0, atDistanceFrom (Position (0,0)) 100] plane_ref
creature_ref <- dbAddCreature creature (Standing plane_ref landing_site Here)
setPlayerCreature creature_ref
_ <- createTown plane_ref [basic_stargate]
......
{-# LANGUAGE ExistentialQuantification, Rank2Types, ScopedTypeVariables #-}
-- Mechanics
module Roguestar.Lib.Behavior
(Behavior(..),
facingBehavior,
......@@ -21,7 +22,7 @@ import Roguestar.Lib.Behavior.Travel
import Roguestar.Lib.TravelData
import Roguestar.Lib.Creature
import Roguestar.Lib.CreatureData
import Roguestar.Lib.Plane
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.PlaneVisibility
import Data.List
import Control.Monad.Maybe
......@@ -31,7 +32,7 @@ import Roguestar.Lib.Behavior.Construction
import Roguestar.Lib.Building
import Roguestar.Lib.Reference
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.Plane
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.PlaneData
--
......
......@@ -18,7 +18,7 @@ import Roguestar.Lib.Facing
import Data.Maybe
import Roguestar.Lib.Behavior.DeviceActivation
import Roguestar.Lib.Contact
import Roguestar.Lib.Plane as Plane
import Roguestar.Lib.Core.Plane as Plane
import Roguestar.Lib.DetailedLocation
data AttackModel =
......
......@@ -7,7 +7,7 @@ module Roguestar.Lib.Behavior.Construction
where
import Roguestar.Lib.DB
import Roguestar.Lib.Plane
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.PlaneData
import Roguestar.Lib.TerrainData
import Roguestar.Lib.Facing
......
......@@ -14,7 +14,7 @@ module Roguestar.Lib.Behavior.Travel
import Control.Monad.Maybe
import Roguestar.Lib.Facing
import Roguestar.Lib.DB as DB
import Roguestar.Lib.Plane
import Roguestar.Lib.Core.Plane
import Data.Maybe
import Control.Monad
import Control.Monad.Trans
......
{-# LANGUAGE ScopedTypeVariables #-}
--Core
module Roguestar.Lib.Building
(buildingSize,
buildingShape,
......@@ -17,7 +17,7 @@ import Data.Maybe
import Control.Monad.Maybe
import Control.Monad.Random
import Roguestar.Lib.PlaneData
import Roguestar.Lib.Plane
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.Position
import Roguestar.Lib.TerrainData
import Control.Monad.Error
......@@ -60,8 +60,8 @@ activateBuilding :: BuildingBehavior -> CreatureRef -> BuildingRef -> DB Bool
activateBuilding (PowerUp pud) creature_ref building_ref =
do captureNode pud creature_ref building_ref
return True
activateBuilding (TwoWayStargate region) creature_ref building_ref =
do (Parent plane_ref :: Parent Plane,building_position :: Position) <- liftM detail $ getPlanarLocation building_ref
activateBuilding (TwoWayStargate _) creature_ref building_ref =
do (Parent _ :: Parent Plane,building_position :: Position) <- liftM detail $ getPlanarLocation building_ref
(creature_position :: Position) <- liftM detail $ getPlanarLocation creature_ref
case () of
() | distanceBetweenChessboard creature_position building_position == 1 ->
......@@ -70,10 +70,10 @@ activateBuilding (TwoWayStargate region) creature_ref building_ref =
do throwError $ DBErrorFlag BuildingApproachWrongAngle
return True
activateBuilding (OneWayStargate region) creature_ref building_ref =
do (Parent plane_ref :: Parent Plane,Position (bx,by))
do (Parent plane_ref :: Parent Plane,Position (_,by))
<- liftM detail $ getPlanarLocation building_ref
(Position (cx,cy)) <- liftM detail $ getPlanarLocation creature_ref
case () of
(Position (_,cy)) <- liftM detail $ getPlanarLocation creature_ref
_ <- case () of
() | cy - by == 1 ->
do subsequent_plane <- maybe (throwError $ DBErrorFlag NoStargateAddress) return
=<< getSubsequent region plane_ref
......@@ -89,7 +89,7 @@ portalCreatureTo building_behavior offset creature_ref plane_ref =
portals <- filterM (liftM ((== building_behavior) . 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 <- pickM portals
else do portal <- weightedPickM $ unweightedSet portals
liftM (offsetPosition (0,offset) . detail) $ getPlanarLocation portal
position <- pickRandomClearSite 1 0 0 ideal_position (not . (`elem` impassable_terrains)) plane_ref
dbPushSnapshot $ TeleportEvent creature_ref
......
-- Data
module Roguestar.Lib.BuildingData
(Building(..),
BuildingBehavior(..),
......
-- Core
module Roguestar.Lib.Character
(applyCharacterClass)
where
import Roguestar.Lib.Alignment
import Roguestar.Lib.CreatureData
import Roguestar.Lib.TerrainData
import Roguestar.Lib.PersistantData
applyCharacterClass :: CharacterClass -> Creature -> Creature
......
-- Mechanics
module Roguestar.Lib.CharacterAdvancement
(CharacterBumpResult(..),
characterFitness,
......
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
-- Mechanics
module Roguestar.Lib.Contact
(findContacts,
ContactMode(..),
......@@ -10,14 +11,11 @@ import Prelude hiding (getContents)
import Roguestar.Lib.Position as Position
import Roguestar.Lib.Facing
import Roguestar.Lib.DB
import Roguestar.Lib.Reference
import Roguestar.Lib.CreatureData
import Control.Monad
import Roguestar.Lib.Plane
import Roguestar.Lib.PlaneData
import Data.Ord
import Data.List as List
import Data.Maybe
import Roguestar.Lib.DetailedLocation
-- | 'Touch' contacts are on the same or facing square as the subject.
......
{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, OverloadedStrings, PatternGuards, TypeFamilies, ExistentialQuantification #-}
module Roguestar.Lib.Plane
module Roguestar.Lib.Core.Plane
(dbNewPlane,
planetName,
randomPlanetName,
planeDepth,
getCurrentPlane,
Roguestar.Lib.Plane.distanceBetweenSquared,
Roguestar.Lib.Core.Plane.distanceBetweenSquared,
pickRandomClearSite_withTimeout,
pickRandomClearSite,
getPlanarLocation,
......@@ -15,14 +15,7 @@ module Roguestar.Lib.Plane
setTerrainAt,
whatIsOccupying,
isTerrainPassable,
getBiome,
SiteCriteria(..),
SimpleSiteCriteria,
areaClearForObjectPlacement,
onTerrainType,
closeTo,
atDistanceFrom,
pickRandomSite)
getBiome)
where
import Prelude hiding (getContents)
......@@ -47,8 +40,6 @@ import Roguestar.Lib.BuildingData
import Roguestar.Lib.Logging
import Control.Monad.Maybe
import Control.Monad.Trans
import Data.Ord
import qualified Data.Vector.Unboxed as Vector
dbNewPlane :: (LocationConstructor l, ReferenceTypeOf l ~ Plane) => B.ByteString -> TerrainGenerationData -> l -> DB PlaneRef
dbNewPlane name tg_data l =
......@@ -228,76 +219,3 @@ isTerrainPassable plane_ref creature_ref position =
getBiome :: (DBReadable db) => PlaneRef -> db Biome
getBiome = liftM plane_biome . dbGetPlane
-- |
-- Criteria for randomly choosing sites to place things on a plane.
-- As a simple example, a building should randomly put on a site where there are not already any buildings.
class SiteCriteria a where
testSiteCriteria :: (DBReadable db) => PlaneRef -> Position -> a -> db Double
data SimpleSiteCriteria =
TerrainClear { _terrain_clear_radius :: Integer,
_terrain_clear_test :: TerrainPatch -> Bool } |
ObjectClear { _object_clear_radius :: Integer } |
AtDistanceFrom { _at_distance_from_center :: Position,
_at_distance :: Integer } |
forall a. SiteCriteria a => RequireAtLeast { require_at_least :: Double, require_at_least_criteria :: a }
instance SiteCriteria SimpleSiteCriteria where
testSiteCriteria plane_ref (Position (x,y)) (TerrainClear radius testF) =
do let ps = [Position (x',y') | x' <- [x-radius..x+radius], y' <- [y-radius..y+radius]]
p_count = realToFrac $ length ps
liftM sum $ forM ps $ \p ->
do t <- terrainAt plane_ref p
case testF t of
True -> return $ 1/p_count
False -> return $ -1/p_count
testSiteCriteria plane_ref (Position (x,y)) (ObjectClear radius) =
do let ps = [Position (x',y') | x' <- [x-radius..x+radius], y' <- [y-radius..y+radius]]
p_count = realToFrac $ length ps
liftM sum $ forM ps $ \p ->
do o <- whatIsOccupying plane_ref p
case o of
[] -> return $ 1/p_count
_ -> return $ -1/p_count
testSiteCriteria plane_ref (Position (x,y)) (AtDistanceFrom (Position (x',y')) distance) = return $ 1.0 / (abs $ sqrt (fromInteger ((x-x')^2 + (y-y')^2)) - fromInteger distance)
testSiteCriteria plane_ref p require@(RequireAtLeast { require_at_least_criteria = criteria }) =
do result <- testSiteCriteria plane_ref p criteria
case result > require_at_least require of
False -> return $ result-1e6
True -> return result
-- SiteCriteria that requires a radius in which there should be no other buildings, objects, or impassable terrain.
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 = RequireAtLeast 0 $ TerrainClear 0 (== terrain)
-- SiteCriteria that tries to get as close to the specified position as possible.
closeTo :: Position -> SimpleSiteCriteria
closeTo p = AtDistanceFrom p 0
-- SiteCriteria that tries to get at a specific distance from the specified position.
atDistanceFrom :: Position -> Integer -> SimpleSiteCriteria
atDistanceFrom p d = AtDistanceFrom p d
instance SiteCriteria a => SiteCriteria [a] where
testSiteCriteria plane_ref p xs = liftM sum $ mapM (testSiteCriteria plane_ref p) xs
pickRandomSite :: (DBReadable db, SiteCriteria a) => (Integer,Integer) -> (Integer,Integer) -> Integer -> a -> PlaneRef -> db Position
pickRandomSite east_west north_south tryhard site_criteria plane_ref =
do xs <- uniformVector (fromInteger tryhard) (0, fromInteger $ snd north_south - fst north_south)
ys <- uniformVector (fromInteger tryhard) (0, fromInteger $ snd east_west - fst east_west)
liftM pickBest $ forM [1.. fromInteger tryhard] (generateOption xs ys)
where pickBest :: [(Double,Position)] -> Position
pickBest = snd . maximumBy (comparing fst)
generateOption :: (DBReadable db) => Vector.Vector Int -> Vector.Vector Int -> Int -> db (Double,Position)
generateOption xs ys i =
do let x = toInteger (Vector.unsafeIndex xs i) + fst north_south
y = toInteger (Vector.unsafeIndex ys i) + snd north_south
let p = Position (x,y)
fitness <- testSiteCriteria plane_ref p site_criteria
return (fitness,p)
{-# LANGUAGE TypeFamilies, PatternGuards #-}
--Core
module Roguestar.Lib.Creature
(generateInitialPlayerCreature,
newCreature,
......@@ -24,12 +24,9 @@ import Roguestar.Lib.Species
import Roguestar.Lib.FactionData
import Control.Monad.Error
import Control.Monad.Random
import Roguestar.Lib.Tool
import Data.Monoid
import Data.Ratio
import Roguestar.Lib.Facing
import Roguestar.Lib.Position
import Roguestar.Lib.Plane
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.PlayerState
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.Logging
......
--Data
module Roguestar.Lib.CreatureData
(Creature(..),
CreatureTrait(..),
......@@ -13,13 +13,11 @@ module Roguestar.Lib.CreatureData
where
import Roguestar.Lib.PersistantData
import Roguestar.Lib.Alignment
import Data.Ratio
import Data.Maybe
import Roguestar.Lib.FactionData
import Data.Monoid
import qualified Data.Map as Map
import qualified Data.Set as Set
import Roguestar.Lib.SpeciesData
import Roguestar.Lib.TerrainData
......@@ -113,17 +111,17 @@ instance CreatureScore CharacterClass where
-- | Calculator to determine how many ranks a creature has in an ability.
-- Number of aptitude points plus n times number of ability points
figureAbility :: [CreatureTrait] -> Creature -> Integer
figureAbility traits c = round $ realToFrac x ** (1.0 / realToFrac (length traits))
figureAbility traits c = round $ (realToFrac x :: Double) ** (1.0 / realToFrac (length traits))
where x = product (map ((+1) . flip rawScore c) traits)
creatureAbilityScore :: CreatureAbility -> Creature -> Integer
creatureAbilityScore ToughnessTrait = figureAbility [Caution,Fortitude]
creatureAbilityScore (AttackSkill x) = figureAbility [Aggression,Dexterity]
creatureAbilityScore (DefenseSkill x) = figureAbility [Caution,Dexterity]
creatureAbilityScore (DamageSkill x) = figureAbility [Aggression,Bulk]
creatureAbilityScore (DamageReductionTrait x) = figureAbility [Caution,Bulk]
creatureAbilityScore (ReloadSkill x) = figureAbility [Aggression,Speed]
creatureAbilityScore (TerrainAffinity terrain_type) = figureAbility []
creatureAbilityScore (AttackSkill _) = figureAbility [Aggression,Dexterity]
creatureAbilityScore (DefenseSkill _) = figureAbility [Caution,Dexterity]
creatureAbilityScore (DamageSkill _) = figureAbility [Aggression,Bulk]
creatureAbilityScore (DamageReductionTrait _) = figureAbility [Caution,Bulk]
creatureAbilityScore (ReloadSkill _) = figureAbility [Aggression,Speed]
creatureAbilityScore (TerrainAffinity _) = figureAbility []
creatureAbilityScore HideSkill = figureAbility [Aggression,Perception]
creatureAbilityScore SpotSkill = figureAbility [Caution,Perception]
creatureAbilityScore JumpSkill = figureAbility [Speed]
......
......@@ -6,6 +6,7 @@
ScopedTypeVariables,
TypeFamilies #-}
--Core
module Roguestar.Lib.DB
(DB,
runDB,
......@@ -109,7 +110,7 @@ runDB :: DB a -> DB_BaseType -> IO (Either DBError (a,DB_BaseType))
runDB dbAction database =
do rng <- randomIO
(seed :: Vector.Vector Word32) <- MWC.withSystemRandom . MWC.asGenIO $ \gen ->
MWC.uniformVector gen 256
MWC.uniformVector gen 2
return $ runST $
do mwc_rng_ref <- newSTRef =<< MWC.initialize seed
data_ref <- newSTRef database
......
{-# LANGUAGE ScopedTypeVariables, PatternGuards, TypeFamilies #-}
--Data
module Roguestar.Lib.DBData
(Reference,
toUID,
......@@ -36,7 +36,6 @@ import Roguestar.Lib.ToolData
import Roguestar.Lib.CreatureData
import Roguestar.Lib.PlaneData
import Roguestar.Lib.BuildingData
import Data.Maybe
import Control.Monad
import Roguestar.Lib.Position
import Roguestar.Lib.Reference
......@@ -146,7 +145,7 @@ instance LocationDetail Position where
fromLocation (IsBeneath {}) = Nothing
instance LocationDetail MultiPosition where
fromLocation (IsConstructed b c) = Just $ multiPosition (constructed_position c) (buildingOccupies $ constructed_shape c)
fromLocation (IsConstructed _ c) = Just $ multiPosition (constructed_position c) (buildingOccupies $ constructed_shape c)
fromLocation x = fmap (toMultiPosition :: Position -> MultiPosition) $ fromLocation x
instance LocationDetail Facing where
......@@ -210,5 +209,5 @@ returnToInventory _ | otherwise = Nothing
shuntToTheUniverse :: Location -> Maybe Location
shuntToTheUniverse l | Just (Child plane) <- fromLocation l = Just $ InTheUniverse plane
shuntToTHeUniverse _ | otherwise = Nothing
shuntToTheUniverse _ | otherwise = Nothing
--Data
module Roguestar.Lib.DBErrorFlag
(DBError(..),
ErrorFlag(..))
......
--Data
module Roguestar.Lib.DBPrivate
(Reference(..),
unsafeReference,
......
{-# LANGUAGE TypeFamilies, EmptyDataDecls, ScopedTypeVariables, PatternGuards, FlexibleContexts #-}
--Core
module Roguestar.Lib.DetailedLocation
(DetailedLocation,
PlaneLocation,
BuildingLocation,
CreatureLocation,
ToolLocation,
CarriedLocation,
PlanarLocation,
......@@ -82,6 +83,7 @@ instance LocationConstructor Planar where
constructLocation building_ref $ Constructed (planar_parent planar)
(planar_position planar)
(error "LocationConstructor Planar: constructLocation: indeterminate")
constructLocation _ _ | otherwise = error "LocationConstructor Planar - constructLocation: failed match"
-- | Meaning that an assignment from one location type to another is guaranteed to succeed.
data Supported
......
{-# LANGUAGE TypeFamilies #-}
--Core
module Roguestar.Lib.DetailedTravel
(Roguestar.Lib.DetailedTravel.whereIs,
Roguestar.Lib.DetailedTravel.getContents)
......
{-# LANGUAGE OverloadedStrings #-}
--Data
module Roguestar.Lib.Facing
(Facing(..),
facingToRelative,
......@@ -15,15 +16,15 @@ import Data.List
import qualified Data.ByteString.Char8 as B
data Facing = North
| NorthEast
| East
| SouthEast
| South
| SouthWest
| West
| NorthWest
| Here
deriving (Eq,Ord,Enum,Bounded,Read,Show)
| NorthEast
| East
| SouthEast
| South
| SouthWest
| West
| NorthWest
| Here
deriving (Eq,Ord,Enum,Bounded,Read,Show)
-- |
-- Takes an abbreviation (n,e,sw, etc) and answers a facing.
......
{-# LANGUAGE OverloadedStrings #-}
--Data
module Roguestar.Lib.FactionData
(Faction(..),factionPrefix)
where
......
--Data
module Roguestar.Lib.GridRayCaster
(castRays,
castRay,
......
{-# LANGUAGE ScopedTypeVariables #-}
-- Data
module Roguestar.Lib.Grids
(Grid,
gridAt,
......@@ -13,6 +15,7 @@ import Data.List as List
import Roguestar.Lib.Random
import Data.MemoCombinators
import Control.Arrow
import qualified Data.Vector as Vector
newtype SeededGrid = SeededGrid Integer deriving (Read,Show)
data StorableCachedGrid a = StorableCachedGrid (Grid a) ((Integer,Integer) -> a)
......@@ -23,30 +26,39 @@ instance (Show a) => Show (StorableCachedGrid a) where
instance (Read a,Ord a) => Read (StorableCachedGrid a) where
readsPrec = (List.map (first storableCachedGrid) .) . readsPrec
storableCachedGrid :: (Ord a) => Grid a -> StorableCachedGrid a
storableCachedGrid g = StorableCachedGrid g $ pair integral integral $ gridAt g
{-# INLINE tile_size #-}
tile_size :: (Integral i) => i
tile_size = 16
storableCachedGrid :: forall a. (Ord a) => Grid a -> StorableCachedGrid a
storableCachedGrid g = StorableCachedGrid g $ \(x,y) ->
flip Vector.unsafeIndex (fromInteger $ (y `mod` tile_size)*tile_size + x `mod` tile_size) $ cache (x `div` tile_size, y `div` tile_size)
where cache = pair integral integral $ tiledGridAt g
tiledGridAt :: (Ord a) => Grid a -> (Integer,Integer) -> Vector.Vector a
tiledGridAt g (x,y) = Vector.generate (tile_size*tile_size) $ \i -> gridAt g (x*tile_size + toInteger i `mod` tile_size, y*tile_size + toInteger i `div` tile_size)
seededGrid :: Integer -> SeededGrid
seededGrid n = SeededGrid n
seededLookup :: SeededGrid -> (Integer,Integer) -> Integer
seededLookup (SeededGrid n) (x,y) = toInteger $ fst $ next $ mkRNG $
(fst $ next $ mkRNG (fromInteger $ (x*809) `mod` max_int)) +
(fst $ next $ mkRNG (fromInteger $ (y*233) `mod` max_int)) +
(fromInteger $ n `mod` max_int)
seededLookup (SeededGrid n) (x,y) = blurp $
((x*809) `mod` max_int) +
((y*233) `mod` max_int) +
(n `mod` max_int)
where max_int = toInteger (maxBound :: Int)
data Grid a = CompletelyRandomGrid {
_grid_seed :: SeededGrid,
_grid_weights :: [(Integer,a)] }
_grid_weights :: WeightedSet a }
| InterpolatedGrid {
_grid_seed :: SeededGrid,
_grid_interpolation_weights :: Map (a,a) [(Integer,a)],
_grid_interpolation_weights :: Map (a,a) (WeightedSet a),
grid_next :: Grid a }
| ArbitraryReplacementGrid {
_grid_seed :: SeededGrid,
_grid_sources :: [(Double,a)],
_grid_replacement_weights :: [(Integer,a)],
_grid_replacement_weights :: WeightedSet a,
_grid_blob :: Blob,
grid_next :: Grid a }
| SpecificPlacementGrid {
......@@ -71,7 +83,7 @@ gridAt (InterpolatedGrid seeded interpolation_map grid) at@(x,y) =
gridAt (ArbitraryReplacementGrid seeded sources replacements blob grid) at =
case fmap fst $ find ((== here) . snd) sources of
Just frequency | (realToFrac (seededLookup seeded at `mod` 100) / 100 < frequency * evalBlob blob at) ->
Just frequency | (fromInteger (seededLookup seeded at `mod` 100) / 100 < frequency * evalBlob blob at) ->
fst $ weightedPick replacements (mkRNG $ seededLookup seeded at)
_ -> here
where here = gridAt grid at
......@@ -90,17 +102,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) => [(Integer,a)] -> Map (a,a) [(Integer,a)] -> Integer -> [Integer] -> Grid a
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 $
in optimizeGrid $ InterpolatedGrid (seededGrid seed) interps $
generateGrid weights interps (n-1) (tail seeds)
-- |
-- Arbitrarily (randomly) replaces some elements of a grid with another.
--
arbitraryReplaceGrid :: (Ord a) => [(Double,a)] -> [(Integer,a)] -> Integer -> Blob -> Grid a -> Grid a
arbitraryReplaceGrid :: (Ord a) => [(Double,a)] -> WeightedSet a -> Integer -> Blob -> Grid a -> Grid a
arbitraryReplaceGrid sources replacements seed blob grid = optimizeGrid $
ArbitraryReplacementGrid (seededGrid seed) sources replacements blob grid
......@@ -116,10 +128,10 @@ specificReplaceGrid position x grid = specificReplaceGrid position x $ SpecificP
-- Strip the cache out of lower layers of the grid, but apply a cache to the top layer.
--
optimizeGrid :: (Ord a) => Grid a -> Grid a
optimizeGrid = cachedGridOf . stripCache
where stripCache (CachedGrid (StorableCachedGrid g _)) = g
stripCache g@(CompletelyRandomGrid {}) = g
stripCache grid = grid { grid_next = stripCache $ grid_next grid }
optimizeGrid = cachedGridOf {- . stripCache -}
-- where stripCache (CachedGrid (StorableCachedGrid g _)) = g
-- stripCache g@(CompletelyRandomGrid {}) = g
-- stripCache grid = grid { grid_next = stripCache $ grid_next grid }
-- |
-- A function from (x,y) to intensity. Used to characterize the general shape of ArbitraryPlacementGrids.
......@@ -127,11 +139,11 @@ optimizeGrid = cachedGridOf . stripCache
--
data Blob =
UnitBlob
| ConeBlob {
cone_blob_center :: (Double,Double),
cone_blob_radius :: Double }
| ConeBlob {
_cone_blob_center :: (Double,Double),
_cone_blob_radius :: Double }
deriving (Read,Show)
evalBlob :: Blob -> (Integer,Integer) -> Double
evalBlob UnitBlob _ = 1
evalBlob (ConeBlob (u,v) r) (x,y) = max 0 $ 1 - (sqrt $ (u-realToFrac x)**2 + (v-realToFrac y)**2) / r
\ No newline at end of file
evalBlob (ConeBlob (u,v) r) (x,y) = max 0 $ 1 - (sqrt $ (u-fromInteger x)**2 + (v-fromInteger y)**2) / r
-- Services
module Roguestar.Lib.HierarchicalDatabase
(HierarchicalDatabase,
HierarchicalRelation(..),
......
--Services
module Roguestar.Lib.Logging
(initLogging,
log_creature,
......
{-# LANGUAGE FlexibleInstances #-}
--Mechanics
module Roguestar.Lib.MakeData
(PrepareMake(..),
prepare_make,
......
{-# LANGUAGE ExistentialQuantification, Rank2Types, FlexibleContexts, ScopedTypeVariables, PatternGuards #-}
--Utility
-- | The Perception monad is a wrapper for roguestar's core
-- monad that reveals only as much information as a character
-- legitimately has. Thus, it is suitable for writing AI
......@@ -44,7 +45,7 @@ import Roguestar.Lib.Position as Position
import Roguestar.Lib.TerrainData
import Roguestar.Lib.BuildingData
import Roguestar.Lib.Building
import Roguestar.Lib.Plane
import Roguestar.Lib.Core.Plane
import Roguestar.Lib.DetailedLocation
import Roguestar.Lib.Building
import Roguestar.Lib.SpeciesData
......
--Data
module Roguestar.Lib.PersistantData
(CharacterClass(..),
PowerUpData(..),
......
--Data
module Roguestar.Lib.PlaneData
(Plane(..))