Permalink
Browse files

Support buildings: Stargate, and Monolith.

  • Loading branch information...
1 parent 31a5eb1 commit 1b246cf2564d35c0ca13a83fb844f3289dda313e @clanehin committed Sep 27, 2009
Showing with 288 additions and 35 deletions.
  1. +2 −6 roguestar-engine.cabal
  2. +3 −0 src/BeginGame.hs
  3. +22 −0 src/Building.hs
  4. +25 −0 src/BuildingData.hs
  5. +36 −0 src/DB.hs
  6. +45 −0 src/DBData.hs
  7. +20 −1 src/DBPrivate.hs
  8. +14 −8 src/Plane.hs
  9. +13 −9 src/PlaneVisibility.hs
  10. +55 −7 src/Position.hs
  11. +14 −3 src/Protocol.hs
  12. +20 −1 src/Random.hs
  13. +19 −0 src/Town.hs
View
@@ -12,11 +12,7 @@ description: Roguestar is a science fiction themed roguelike (turn-based
provides the core game engine; you'll probably want to also install the
OpenGL client.
.
- This initial release allows you to play one of six alien races. You begin
- the game stranded on an alien planet, fighting off an endless hoard of
- hostile robots.
- .
- The Darcs repository is available at <http://www.downstairspeople.org/darcs/roguestar-engine>.
+ The git repository is available at <http://www.downstairspeople.org/git/roguestar-engine.git>.
homepage: http://roguestar.downstairspeople.org/
build-depends: base>3, containers, array, old-time, random, mtl, MaybeT, MonadRandom
@@ -35,7 +31,7 @@ other-modules: VisibilityData, Stats, FactionData, Behavior, Alignment,
RNG, Species, Position, TerrainData, Combat,
Tests, DBData, GridRayCaster, BeginGame,
SpeciesData, TimeCoordinate, DB, HopList, AttributeGeneration,
- CreatureAttribute
+ CreatureAttribute, Building, BuildingData, Town
ghc-options: -Wall -threaded -fno-warn-type-defaults
ghc-prof-options: -prof -auto-all
View
@@ -7,6 +7,7 @@ import Plane
import CreatureData
import Character
import CharacterData
+import BuildingData
import DB
import DBData
import Facing
@@ -17,6 +18,7 @@ import Control.Monad.Random
import SpeciesData
import Substances
import PlayerState
+import Town
homeBiome :: Species -> Biome
homeBiome Anachronid = ForestBiome
@@ -77,6 +79,7 @@ dbBeginGame creature character_class =
plane_ref <- dbCreateStartingPlane creature
landing_site <- pickRandomClearSite 200 30 2 (Position (0,0)) (not . (`elem` difficult_terrains)) plane_ref
creature_ref <- dbAddCreature first_level_creature (Standing plane_ref landing_site Here)
+ createTown plane_ref [Stargate,Monolith]
let starting_equip = startingEquipmentBySpecies (creature_species creature) ++ startingEquipmentByClass character_class
forM_ starting_equip $ \tool -> dbAddTool tool (Inventory creature_ref)
forM_ [0..10] $ \_ -> do tool_position <- pickRandomClearSite 200 1 2 landing_site (not . (`elem` difficult_terrains)) plane_ref
View
@@ -0,0 +1,22 @@
+module Building
+ (buildingSize,
+ buildingType)
+ where
+
+import DB
+import BuildingData
+import Data.List
+import Control.Monad
+
+-- | The total occupied surface area of a building.
+buildingSize :: (DBReadable db) => BuildingRef -> db Integer
+buildingSize = liftM (genericLength . buildingOccupies) . buildingType
+
+buildingType :: (DBReadable db) => BuildingRef -> db BuildingType
+buildingType building_ref =
+ do constructed <- liftM extractLocation $ dbWhere building_ref
+ case constructed of
+ Just (Constructed _ _ building_type) -> return building_type
+ _ -> error "buildingSize: impossible case"
+
+
View
@@ -0,0 +1,25 @@
+
+module BuildingData
+ (Building(..),
+ BuildingType(..),
+ buildingOccupies)
+ where
+
+data Building = Building
+ deriving (Read,Show)
+
+data BuildingType = Monolith | Stargate
+ deriving (Eq,Ord,Read,Show)
+
+-- | Get a list of squares, relative to the center of the building (0,0),
+-- that a building occupies. These squares must be free of unfriendly terrain
+-- (mountains, trees, water, lava, etc.) and no other objects can co-occupy these squares.
+--
+-- A goal is that every building type has a unique square occupation signature,
+-- so that it can be identified by it's shape alone.
+buildingOccupies :: BuildingType -> [(Integer,Integer)]
+-- Monolith: X
+buildingOccupies Monolith = [(0,0)]
+-- Stargate: XXX
+buildingOccupies Stargate = [(0,0),(-1,0),(1,0)]
+
View
@@ -16,13 +16,16 @@ module DB
dbAddCreature,
dbAddPlane,
dbAddTool,
+ dbAddBuilding,
dbUnsafeDeleteObject,
dbGetCreature,
dbGetPlane,
dbGetTool,
+ dbGetBuilding,
dbModCreature,
dbModPlane,
dbModTool,
+ dbModBuilding,
dbMove,
dbUnwieldCreature,
dbVerify,
@@ -49,6 +52,7 @@ import DBPrivate
import DBData
import CreatureData
import PlaneData
+import BuildingData
import RNG
import Data.Map as Map
import Data.List as List
@@ -77,6 +81,7 @@ data DB_BaseType = DB_BaseType { db_player_state :: PlayerState,
db_creatures :: Map CreatureRef Creature,
db_planes :: Map PlaneRef Plane,
db_tools :: Map ToolRef Tool,
+ db_buildings :: Map BuildingRef Building,
db_hierarchy :: HierarchicalDatabase (Location S (Reference ()) ()),
db_time_coordinates :: Map (Reference ()) TimeCoordinate,
db_error_flag :: String,
@@ -189,6 +194,7 @@ initial_db = DB_BaseType {
db_creatures = Map.fromList [],
db_planes = Map.fromList [],
db_tools = Map.fromList [],
+ db_buildings = Map.fromList [],
db_hierarchy = HierarchicalDatabase.fromList [],
db_error_flag = [],
db_time_coordinates = Map.fromList [(generalizeReference the_universe, zero_time)],
@@ -230,6 +236,9 @@ class (LocationType l) => CreatureLocation l where
class (LocationType l) => ToolLocation l where
toolLocation :: ToolRef -> l -> Location m ToolRef l
+class (LocationType l) => BuildingLocation l where
+ buildingLocation :: BuildingRef -> l -> Location m BuildingRef l
+
instance CreatureLocation Standing where
creatureLocation a l = IsStanding (unsafeReference a) l
@@ -242,6 +251,9 @@ instance ToolLocation Inventory where
instance ToolLocation Wielded where
toolLocation a l = IsWielded (unsafeReference a) l
+instance BuildingLocation Constructed where
+ buildingLocation a l = IsConstructed (unsafeReference a) l
+
-- |
-- Adds something to a map in the database using a new object reference.
--
@@ -277,6 +289,12 @@ dbAddTool :: (ToolLocation l) => Tool -> l -> DB ToolRef
dbAddTool = dbAddObjectComposable ToolRef dbPutTool toolLocation
-- |
+-- Adds a new Tool to the database.
+--
+dbAddBuilding :: (BuildingLocation l) => Building -> l -> DB BuildingRef
+dbAddBuilding = dbAddObjectComposable BuildingRef dbPutBuilding buildingLocation
+
+-- |
-- This deletes an object, but leaves any of it's contents dangling.
--
dbUnsafeDeleteObject :: (ReferenceType e) =>
@@ -323,6 +341,12 @@ dbPutTool :: ToolRef -> Tool -> DB ()
dbPutTool = dbPutObjectComposable db_tools (\x db_base_type -> db_base_type { db_tools = x })
-- |
+-- Puts a Building under an arbitrary BuildingRef
+--
+dbPutBuilding :: BuildingRef -> Building -> DB ()
+dbPutBuilding = dbPutObjectComposable db_buildings (\x db_base_type -> db_base_type { db_buildings = x })
+
+-- |
-- Gets an object from the database using getter functions.
--
dbGetObjectComposable :: (DBReadable db,Ord a,GenericReference a x) => String -> (DB_BaseType -> Map a b) -> a -> db b
@@ -348,6 +372,12 @@ dbGetTool :: (DBReadable m) => ToolRef -> m Tool
dbGetTool = dbGetObjectComposable "ToolRef" db_tools
-- |
+-- Gets a Plane from a PlaneRef
+--
+dbGetBuilding :: (DBReadable m) => BuildingRef -> m Building
+dbGetBuilding = dbGetObjectComposable "BuildingRef" db_buildings
+
+-- |
-- Modifies an Object based on an ObjectRef.
--
dbModObjectComposable :: (Reference e -> DB e) -> (Reference e -> e -> DB ()) ->
@@ -373,6 +403,12 @@ dbModTool :: (Tool -> Tool) -> ToolRef -> DB ()
dbModTool = dbModObjectComposable dbGetTool dbPutTool
-- |
+-- Modifies a Tool based on a PlaneRef.
+--
+dbModBuilding :: (Building -> Building) -> BuildingRef -> DB ()
+dbModBuilding = dbModObjectComposable dbGetBuilding dbPutBuilding
+
+-- |
-- Set the location of an object.
--
dbSetLocation :: (LocationType e,LocationType t) => Location S e t -> DB ()
View
@@ -6,6 +6,7 @@ module DBData
CreatureRef,
PlaneRef,
ToolRef,
+ BuildingRef,
TheUniverse(..),
the_universe,
(=:=), (=/=),
@@ -19,15 +20,19 @@ module DBData
Dropped(..),
Inventory(..),
Wielded(..),
+ Constructed(..),
_nullary,
_creature,
_tool,
_plane,
+ _building,
_standing,
_dropped,
_inventory,
_wielded,
+ _constructed,
_position,
+ _multiposition,
_facing,
_the_universe,
asLocationTyped,
@@ -53,6 +58,7 @@ module DBData
toDropped,
toInventory,
toWielded,
+ toConstructed,
returnToInventory)
where
@@ -61,6 +67,7 @@ import DBPrivate
import ToolData
import CreatureData
import PlaneData
+import BuildingData
import Data.Maybe
import Control.Monad
import Position
@@ -82,6 +89,9 @@ _tool = Type $ error "_tool: undefined"
_plane :: Type PlaneRef
_plane = Type $ error "_plane: undefined"
+_building :: Type BuildingRef
+_building = Type $ error "_building: undefined"
+
_standing :: Type Standing
_standing = Type $ error "_standing: undefined"
@@ -94,9 +104,15 @@ _inventory = Type $ error "_inventory: undefined"
_wielded :: Type Wielded
_wielded = Type $ error "_wielded: undefined"
+_constructed :: Type Constructed
+_constructed = Type $ error "_constructed: undefined"
+
_position :: Type Position
_position = Type $ error "_position: undefined"
+_multiposition :: Type MultiPosition
+_multiposition = Type $ error "_multiposition: undefined"
+
_facing :: Type Facing
_facing = Type $ error "_facing: undefined"
@@ -110,6 +126,13 @@ class GenericReference a m | a -> m where
fromLocation :: (ReferenceType x) => Location m (Reference x) b -> Maybe a
generalizeReference :: a -> Reference ()
+instance (GenericReference a m,GenericReference b m) => GenericReference (Either a b) m where
+ fromLocation x = case (fromLocation x,fromLocation x) of
+ (Just a,_) -> Just $ Left a
+ (_,Just b) -> Just $ Right b
+ _ | otherwise -> Nothing
+ generalizeReference = either generalizeReference generalizeReference
+
instance (ReferenceType a) => GenericReference (Reference a) m where
fromLocation = coerceReference . entity
generalizeReference = unsafeReference
@@ -161,6 +184,10 @@ instance ReferenceType Creature where
coerceReference (CreatureRef ref) = Just $ CreatureRef ref
coerceReference _ = Nothing
+instance ReferenceType Building where
+ coerceReference (BuildingRef ref) = Just $ BuildingRef ref
+ coerceReference _ = Nothing
+
instance ReferenceType TheUniverse where
coerceReference UniverseRef = Just UniverseRef
coerceReference _ = Nothing
@@ -182,13 +209,15 @@ getLocation (IsStanding _ s) = unsafeReference $ standing_plane s
getLocation (IsDropped _ d) = unsafeReference $ dropped_plane d
getLocation (InInventory _ c) = unsafeReference $ inventory_creature c
getLocation (IsWielded _ c) = unsafeReference $ wielded_creature c
+getLocation (IsConstructed _ c) = unsafeReference $ constructed_plane c
getLocation (InTheUniverse _) = unsafeReference UniverseRef
getEntity :: Location m e t -> Reference ()
getEntity (IsStanding r _) = unsafeReference r
getEntity (IsDropped r _) = unsafeReference r
getEntity (InInventory r _) = unsafeReference r
getEntity (IsWielded r _) = unsafeReference r
+getEntity (IsConstructed r _) = unsafeReference r
getEntity (InTheUniverse r) = unsafeReference r
asLocationTyped :: (LocationType e,LocationType t) => Type e -> Type t -> Location m e t -> Location m e t
@@ -253,6 +282,11 @@ instance LocationType Wielded where
extractLocation _ = Nothing
extractEntity = const Nothing
+instance LocationType Constructed where
+ extractLocation (IsConstructed _ i) = Just i
+ extractLocation _ = Nothing
+ extractEntity = const Nothing
+
instance LocationType () where
extractLocation = const $ Just ()
extractEntity = const Nothing
@@ -262,14 +296,21 @@ instance LocationType Position where
extractLocation (IsDropped _ d) = Just $ dropped_position d
extractLocation (InInventory {}) = Nothing
extractLocation (IsWielded {}) = Nothing
+ extractLocation (IsConstructed _ c) = Just $ constructed_position c
extractLocation (InTheUniverse {}) = Nothing
extractEntity = const Nothing
+instance LocationType MultiPosition where
+ extractLocation (IsConstructed _ c) = Just $ multiPosition (constructed_position c) (buildingOccupies $ constructed_type c)
+ extractLocation x = fmap (toMultiPosition :: Position -> MultiPosition) $ extractLocation x
+ extractEntity = const Nothing
+
instance LocationType Facing where
extractLocation (IsStanding _ s) = Just $ standing_facing s
extractLocation (IsDropped {}) = Nothing
extractLocation (InInventory {}) = Nothing
extractLocation (IsWielded {}) = Nothing
+ extractLocation (IsConstructed {}) = Nothing
extractLocation (InTheUniverse {}) = Nothing
extractEntity = const Nothing
@@ -300,6 +341,10 @@ toWielded :: (LocationType t) => Wielded -> Location m ToolRef t -> Location m T
toWielded i l | isEntityTyped _tool l = IsWielded (entity l) i
toWielded _ _ = error "toWielded: type error"
+toConstructed :: (LocationType t) => Constructed -> Location m BuildingRef t -> Location m BuildingRef Constructed
+toConstructed i l | isEntityTyped _building l = IsConstructed (entity l) i
+toConstructed _ _ = error "toConstructed: type error"
+
returnToInventory :: Location m ToolRef Wielded -> Location m ToolRef Inventory
returnToInventory l = InInventory (entity l) (Inventory c)
where Wielded c = location l
Oops, something went wrong.

0 comments on commit 1b246cf

Please sign in to comment.