Skip to content
Browse files

Adds a cyborg stargate to the engine (no model).

  • Loading branch information...
1 parent fc5125a commit 0f4b3f5d2b653d622bffc13d56fbee1f3f014be5 @clanehin committed
View
25 roguestar-engine/src/Building.hs
@@ -56,22 +56,35 @@ activateBuilding Portal creature_ref building_ref =
() | cy < py ->
do m_subsequent_loc :: Maybe (Location PlaneRef Subsequent) <- liftM listToMaybe $ dbGetContents plane_ref
case m_subsequent_loc of
- Just loc -> (portalCreatureTo 1 creature_ref $ child loc) >> return True
+ Just loc -> (portalCreatureTo Portal 1 creature_ref $ child loc) >> return True
_ -> throwError $ DBErrorFlag NoStargateAddress
() | cy > py ->
do m_previous_loc :: Maybe Subsequent <- liftM extractParent $ dbWhere plane_ref
case m_previous_loc of
- Just loc -> (portalCreatureTo (-1) creature_ref $ subsequent_to loc) >> return True
+ Just loc -> (portalCreatureTo Portal (-1) creature_ref $ subsequent_to loc) >> return True
_ -> throwError $ DBErrorFlag NoStargateAddress
() | otherwise -> throwError $ DBErrorFlag BuildingApproachWrongAngle
_ -> throwError $ DBError "activateBuilding: can't decode building-creature relative positions"
-
+activateBuilding CyberGate creature_ref building_ref =
+ do m_creature_position :: Maybe (PlaneRef,Position) <- liftM extractParent $ dbWhere creature_ref
+ m_portal_position :: Maybe (PlaneRef,Position) <- liftM extractParent $ dbWhere building_ref
+ when (fmap fst m_creature_position /= fmap fst m_portal_position) $ throwError $ DBError "activateBuilding: creature and portal on different planes"
+ case (m_creature_position,m_portal_position) of
+ (Just (plane_ref,Position (cx,cy)),Just (_,Position (px,py))) ->
+ case () of
+ () | cy < py && cx == px ->
+ do m_subsequent_loc :: Maybe (Location PlaneRef Subsequent) <- liftM listToMaybe $ dbGetContents plane_ref
+ case m_subsequent_loc of
+ Just loc -> (portalCreatureTo (Node Monolith) 0 creature_ref $ child loc) >> return True
+ _ -> throwError $ DBErrorFlag NoStargateAddress
+ () | otherwise -> throwError $ DBErrorFlag BuildingApproachWrongAngle
+ _ -> throwError $ DBError "activateBuilding: can't decode building-creature relative positions"
-- | 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 :: Integer -> CreatureRef -> PlaneRef -> DB (Location CreatureRef (),Location CreatureRef Standing)
-portalCreatureTo offset creature_ref plane_ref =
- do portals <- filterM (liftM (== Portal) . buildingType) =<< dbGetContents plane_ref
+portalCreatureTo :: BuildingType -> Integer -> CreatureRef -> PlaneRef -> DB (Location CreatureRef (),Location CreatureRef Standing)
+portalCreatureTo building_type offset creature_ref plane_ref =
+ do portals <- filterM (liftM (== building_type) . buildingType) =<< dbGetContents plane_ref
ideal_position <- if null portals
then liftM2 (\x y -> Position (x,y)) (getRandomR (-100,100)) (getRandomR (-100,100))
else do portal <- pickM portals
View
7 roguestar-engine/src/BuildingData.hs
@@ -11,7 +11,7 @@ module BuildingData
data Building = Building
deriving (Read,Show)
-data BuildingType = Node NodeType | Portal
+data BuildingType = Node NodeType | Portal | CyberGate
deriving (Eq,Ord,Read,Show)
data NodeType = Monolith | Anchor
@@ -35,4 +35,9 @@ buildingOccupies :: BuildingType -> [(Integer,Integer)]
buildingOccupies (Node _) = [(0,0)]
-- Portal: XXX
buildingOccupies Portal = [(0,0),(-1,0),(1,0)]
+-- Cybergate: XXX
+-- XX XX
+-- XX XX
+-- X X
+buildingOccupies CyberGate = [(-3,-3),(-3,-2),(-2,-2),(-2,-1),(-1,-1),(-1,0),(0,0),(1,-1),(1,0),(2,-2),(2,-1),(3,-3),(3,-2)]
View
1 roguestar-engine/src/NodeData.hs
@@ -3,7 +3,6 @@ module NodeData
where
import BuildingData
-import CreatureData
import CharacterData
import CharacterAdvancement
View
6 roguestar-engine/src/Perception.hs
@@ -91,18 +91,18 @@ whereIs :: (DBReadable db) => Reference a -> DBPerception db (Location (Referenc
whereIs ref = liftDB $ dbWhere ref
localBiome :: (DBReadable db) => DBPerception db Biome
-localBiome =
+localBiome =
do plane_ref <- whatPlaneAmIOn
liftDB $ liftM plane_biome $ dbGetPlane plane_ref
compass :: (DBReadable db) => DBPerception db Facing
compass =
- do let signalling_building_types = [Portal] ++ map Node all_nodes
+ do let signalling_building_types = [Portal,CyberGate] ++ map Node all_nodes
(_,pos) <- whereAmI
plane <- whatPlaneAmIOn
liftDB $
do buildings <- liftM (sortBy $ comparing $ distanceBetweenSquared pos . parent) $
- filterM (liftM (`elem` signalling_building_types) . buildingType . child) =<<
+ filterM (liftM (`elem` signalling_building_types) . buildingType . child) =<<
dbGetContents plane
return $ maybe Here (faceAt pos . parent) $ listToMaybe buildings
View
67 roguestar-engine/src/PlanetData.hs
@@ -3,7 +3,7 @@ module PlanetData
(PlanetInfo(..),
addTown,
all_planets,
- pgto_planets)
+ nonaligned_planets)
where
import TerrainData
@@ -32,8 +32,8 @@ data PlanetInfo = PlanetInfo {
planet_info_node_type :: NodeType }
deriving (Read,Show)
-pgto :: Integer -> B.ByteString -> Biome -> PlanetInfo
-pgto x name biome = PlanetInfo {
+nonaligned :: Integer -> B.ByteString -> Biome -> PlanetInfo
+nonaligned x name biome = PlanetInfo {
planet_info_priority = fromInteger x / 3,
planet_info_name = case name of
"" -> Nothing
@@ -48,33 +48,46 @@ pgto x name biome = PlanetInfo {
planet_info_town = [(1,Portal)],
planet_info_node_type = Anchor }
+cyber :: B.ByteString -> Biome -> PlanetInfo
+cyber name biome = PlanetInfo {
+ planet_info_priority = 0.0,
+ planet_info_name = case name of
+ "" -> Nothing
+ _ -> Just name,
+ planet_info_depth = 5,
+ planet_info_biome = biome,
+ planet_info_dungeon = FrozenDungeon,
+ planet_info_town = [(1,CyberGate)],
+ planet_info_node_type = Anchor }
+
addTown :: PlanetInfo -> [(Rational,BuildingType)] -> PlanetInfo
addTown planet_info town = planet_info { planet_info_town = planet_info_town planet_info ++ town }
all_planets :: [PlanetInfo]
-all_planets = concat [pgto_planets]
+all_planets = concat [nonaligned_planets]
-pgto_planets :: [PlanetInfo]
-pgto_planets = [
- pgto 1 "" RockBiome,
- pgto 1 "" IcyRockBiome,
- pgto 1 "" TundraBiome,
- pgto 1 "" DesertBiome,
- pgto 1 "" MountainBiome,
- pgto 2 "roanoke" SwampBiome,
- pgto 2 "pamlico" SwampBiome,
- pgto 2 "pungo" ForestBiome,
- pgto 2 "neuse" ForestBiome,
- pgto 2 "crabtree" SwampBiome,
- pgto 2 "eno" SwampBiome `addTown` [(1%20,Node Monolith)],
- pgto 2 "yadkin" SwampBiome,
- pgto 2 "catawba" ForestBiome,
- pgto 2 "pasquotank" ForestBiome,
- pgto 3 "dogwood" GrasslandBiome,
- pgto 3 "emerald" GrasslandBiome,
- pgto 3 "cardinal" GrasslandBiome,
- pgto 4 "currituck" OceanBiome,
- pgto 4 "hatteras" OceanBiome,
- pgto 4 "lookout" OceanBiome,
- pgto 4 "ocracoke" OceanBiome]
+nonaligned_planets :: [PlanetInfo]
+nonaligned_planets = [
+ cyber "cybernet" IcyRockBiome,
+ nonaligned 1 "" RockBiome,
+ nonaligned 1 "" IcyRockBiome,
+ nonaligned 1 "" TundraBiome,
+ nonaligned 1 "" DesertBiome,
+ nonaligned 1 "" MountainBiome,
+ 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,Node Monolith)],
+ nonaligned 2 "yadkin" SwampBiome,
+ nonaligned 2 "catawba" ForestBiome,
+ nonaligned 2 "pasquotank" ForestBiome,
+ nonaligned 3 "dogwood" GrasslandBiome,
+ nonaligned 3 "emerald" GrasslandBiome,
+ nonaligned 3 "cardinal" GrasslandBiome,
+ nonaligned 4 "currituck" OceanBiome,
+ nonaligned 4 "hatteras" OceanBiome,
+ nonaligned 4 "lookout" OceanBiome,
+ nonaligned 4 "ocracoke" OceanBiome]

0 comments on commit 0f4b3f5

Please sign in to comment.
Something went wrong with that request. Please try again.