Permalink
Browse files

Nodes that can be picked up and add to Characters' score.

  • Loading branch information...
1 parent 5fde770 commit 25168cbfc07e83ad77684052320c51676b448a51 @clanehin committed Jan 1, 2011
View
2 roguestar-engine/src/BeginGame.hs
@@ -79,7 +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 [Portal,Monolith]
+ _ <- createTown plane_ref [Portal,Node 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
11 roguestar-engine/src/Building.hs
@@ -16,6 +16,7 @@ import Plane
import Position
import TerrainData
import Control.Monad.Error
+import CreatureData
-- | The total occupied surface area of a building.
buildingSize :: (DBReadable db) => BuildingRef -> db Integer
@@ -28,6 +29,9 @@ buildingType building_ref =
Just (Constructed _ _ building_type) -> return building_type
_ -> error "buildingSize: impossible case"
+deleteBuilding :: BuildingRef -> DB ()
+deleteBuilding = dbUnsafeDeleteObject (error "deleteBuilding: impossible case, buildings shouldn't contain anything.")
+
-- | Activate the facing building, returns True iff any building was actually activated.
activateFacingBuilding :: Facing -> CreatureRef -> DB Bool
activateFacingBuilding face creature_ref = liftM (fromMaybe False) $ runMaybeT $
@@ -38,7 +42,10 @@ activateFacingBuilding face creature_ref = liftM (fromMaybe False) $ runMaybeT $
activateBuilding building_type creature_ref building_ref
activateBuilding :: BuildingType -> CreatureRef -> BuildingRef -> DB Bool
-activateBuilding Monolith _ _ = return False
+activateBuilding (Node _) creature_ref building_ref =
+ do dbModCreature (\c -> c { creature_points = succ $ creature_points c }) creature_ref
+ deleteBuilding building_ref
+ return True
activateBuilding Portal 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
@@ -73,6 +80,4 @@ portalCreatureTo offset creature_ref plane_ref =
position <- pickRandomClearSite 1 0 0 ideal_position (not . (`elem` impassable_terrains)) plane_ref
dbPushSnapshot $ TeleportEvent creature_ref
dbMove (return . toStanding (Standing plane_ref position Here)) creature_ref
-
-
View
21 roguestar-engine/src/BuildingData.hs
@@ -2,24 +2,37 @@
module BuildingData
(Building(..),
BuildingType(..),
+ NodeType(..),
+ all_nodes,
+ showBuilding,
buildingOccupies)
where
data Building = Building
deriving (Read,Show)
-data BuildingType = Monolith | Portal
+data BuildingType = Node NodeType | Portal
deriving (Eq,Ord,Read,Show)
+data NodeType = Monolith | Anchor
+ deriving (Eq,Ord,Read,Show,Enum,Bounded)
+
+all_nodes :: [NodeType]
+all_nodes = [minBound..maxBound]
+
+showBuilding :: BuildingType -> String
+showBuilding (Node n) = show n
+showBuilding x = show x
+
-- | 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 occupation signature,
-- so that it can be identified by it's shape alone.
buildingOccupies :: BuildingType -> [(Integer,Integer)]
--- Monolith: X
-buildingOccupies Monolith = [(0,0)]
--- Portal: XXX
+-- Monolith: X
+buildingOccupies (Node _) = [(0,0)]
+-- Portal: XXX
buildingOccupies Portal = [(0,0),(-1,0),(1,0)]
View
4 roguestar-engine/src/Character.hs
@@ -18,7 +18,7 @@ data CharacterClassData = CharacterClassData {
character_class_attributes :: CreatureAttribute }
getEligableCharacterClassesComposable :: [CharacterClass] -> Creature -> [CharacterClass]
-getEligableCharacterClassesComposable allowed_classes creature =
+getEligableCharacterClassesComposable allowed_classes creature =
filter (\x -> character_class_prerequisite (classInfo x) creature || isFavoredClass x creature) allowed_classes
getEligableCharacterClasses :: Creature -> [CharacterClass]
@@ -40,7 +40,7 @@ mustHave score min_score creature = (rawScore score creature) >= min_score
-- function). The prerequisite(s) restrict what 'Creatures' can advance in the 'CharacterClass'.
--
-- The second parameter is the list of 'CreatureAttribute's that a Creature gains when it levels in the
--- 'CharacterClass'.
+-- 'CharacterClass'.
--
characterClass :: Prerequisite -> CreatureAttribute -> CharacterClassData
characterClass prereqs attribs = CharacterClassData prereqs attribs
View
42 roguestar-engine/src/CharacterData.hs
@@ -6,31 +6,31 @@ module CharacterData
where
data CharacterClass = Barbarian
- | Consular
- | Engineer
- | ForceAdept
- | Marine
- | Ninja
- | Pirate
- | Scout
- | Shepherd
- | Thief
- | Warrior
- deriving (Eq,Enum,Bounded,Read,Show,Ord)
+ | Consular
+ | Engineer
+ | ForceAdept
+ | Marine
+ | Ninja
+ | Pirate
+ | Scout
+ | Shepherd
+ | Thief
+ | Warrior
+ deriving (Eq,Enum,Bounded,Read,Show,Ord)
all_character_classes :: [CharacterClass]
all_character_classes = [minBound..maxBound]
base_character_classes :: [CharacterClass]
base_character_classes = [Barbarian,
- Consular,
- Engineer,
- ForceAdept,
- Marine,
- Ninja,
- Pirate,
- Scout,
- Shepherd,
- Thief,
- Warrior]
+ Consular,
+ Engineer,
+ ForceAdept,
+ Marine,
+ Ninja,
+ Pirate,
+ Scout,
+ Shepherd,
+ Thief,
+ Warrior]
View
10 roguestar-engine/src/Creature.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE PatternGuards #-}
-module Creature
+module Creature
(generateInitialPlayerCreature,
newCreature,
Roll(..),
@@ -44,7 +44,7 @@ generateCreature faction species = generateAttributes faction species $ mconcat
-- database's DBClassSelectionState.
--
generateInitialPlayerCreature :: Species -> DB ()
-generateInitialPlayerCreature species =
+generateInitialPlayerCreature species =
do newc <- generateCreature Player species
dbSetStartingRace species
setPlayerState (ClassSelectionState newc)
@@ -53,7 +53,7 @@ generateInitialPlayerCreature species =
-- Generates a new Creature from the specified Species and adds it to the database.
--
newCreature :: (CreatureLocation l) => Faction -> Species -> l -> DB CreatureRef
-newCreature faction species loc =
+newCreature faction species loc =
do creature <- generateCreature faction species
dbAddCreature creature loc
@@ -62,7 +62,7 @@ data RollComponents = RollComponents {
component_other_situation_bonus :: Integer,
component_terrain_affinity_bonus :: Integer }
-data Roll = Roll {
+data Roll = Roll {
roll_ideal :: Integer,
roll_actual :: Integer,
roll_ideal_components :: RollComponents,
@@ -140,4 +140,4 @@ sweepDead ref =
do worst_to_best_critters <- sortByRO getCreatureHealth =<< getDead ref
flip mapM_ worst_to_best_critters $ \creature_ref ->
do dbPushSnapshot (KilledEvent creature_ref)
- deleteCreature creature_ref
+ deleteCreature creature_ref
View
21 roguestar-engine/src/CreatureData.hs
@@ -1,5 +1,5 @@
-module CreatureData
+module CreatureData
(Creature(..),
CreatureGender(..),
CreatureAptitude(..),
@@ -30,11 +30,12 @@ data Creature = Creature { creature_aptitude :: Map.Map CreatureAptitude Integer
creature_levels :: Map.Map CharacterClass Integer,
creature_favored_classes :: Set.Set CharacterClass,
creature_gender :: CreatureGender,
- creature_species :: Species,
- creature_random_id :: Integer, -- random number attached to the creature, not unique
- creature_damage :: Integer,
- creature_faction :: Faction }
- deriving (Read,Show)
+ creature_species :: Species,
+ creature_random_id :: Integer, -- random number attached to the creature, not unique
+ creature_damage :: Integer,
+ creature_faction :: Faction,
+ creature_points :: Integer }
+ deriving (Read,Show)
-- | Creature having no attributes and undefined 'creature_species', 'creature_random_id', and 'creature_faction'
--
@@ -49,11 +50,13 @@ empty_creature = Creature {
creature_species = error "empty_creature: undefined creature_species",
creature_random_id = error "empty_creature: undefined creature_random_id",
creature_damage = 0,
- creature_faction = error "empty_creature: undefined creature_faction" }
+ creature_faction = error "empty_creature: undefined creature_faction",
+ creature_points = 0 }
data CreatureGender = Male | Female | Neuter deriving (Eq,Read,Show)
--- | Endomorphisms over a 'Creature'. These are types that contribute some feature to a 'Creature', so that 'Creature's can be defined concisely by those properties.
+-- | Endomorphisms over a 'Creature'. These are types that contribute some feature to a 'Creature',
+-- so that 'Creature's can be defined concisely by those properties.
class CreatureEndo a where
applyToCreature :: a -> Creature -> Creature
@@ -72,7 +75,7 @@ instance CreatureEndo CreatureGender where
applyToCreature g c = c { creature_gender = g }
-- | The seven aptitudes.
-data CreatureAptitude =
+data CreatureAptitude =
Strength
| Speed
| Constitution
View
4 roguestar-engine/src/DB.hs
@@ -333,7 +333,9 @@ dbAddBuilding :: (BuildingLocation l) => Building -> l -> DB BuildingRef
dbAddBuilding = dbAddObjectComposable BuildingRef dbPutBuilding buildingLocation
-- |
--- This deletes an object, but leaves any of it's contents dangling.
+-- This deletes an object, which will cause future references to the same object
+-- to fail. Accepts a function to move all of the objects nested within the
+-- object being deleted.
--
dbUnsafeDeleteObject :: (ReferenceType e) =>
(forall m. DBReadable m =>
View
2 roguestar-engine/src/DBPrivate.hs
@@ -139,7 +139,7 @@ data Location e t =
| InTheUniverse PlaneRef
| IsSubsequent PlaneRef Subsequent
| IsBeneath PlaneRef Beneath
- deriving (Read,Show,Eq,Ord)
+ deriving (Read,Show,Eq)
unsafeLocation :: Location a b -> Location c d
unsafeLocation (IsStanding a b) = IsStanding a b
View
2 roguestar-engine/src/Perception.hs
@@ -97,7 +97,7 @@ localBiome =
compass :: (DBReadable db) => DBPerception db Facing
compass =
- do let signalling_building_types = [Portal,Monolith]
+ do let signalling_building_types = [Portal] ++ map Node all_nodes
(_,pos) <- whereAmI
plane <- whatPlaneAmIOn
liftDB $
View
6 roguestar-engine/src/Planet.hs
@@ -14,6 +14,7 @@ import Town
import Data.List
import Data.ByteString.Char8 as B
import FactionData
+import BuildingData
makePlanet :: (PlaneLocation l) => l -> PlanetInfo -> DB PlaneRef
makePlanet plane_location planet_info =
@@ -33,7 +34,7 @@ makePlanet plane_location planet_info =
do p <- rationalRoll r
return $ if p then Just b else Nothing
_ <- createTown plane_ref town
- _ <- makeDungeons planet_name (Beneath plane_ref) 0 planet_info
+ _ <- makeDungeons planet_name (Beneath plane_ref) 1 planet_info
return plane_ref
makePlanets :: (PlaneLocation l) => l -> [PlanetInfo] -> DB PlaneRef
@@ -62,6 +63,9 @@ makeDungeons planet_name plane_location i planet_info =
[stairsUp seed_up i] ++
if i < n then [stairsDown seed_down i] else [] })
plane_location
+ when (i == n) $
+ do _ <- createTown plane_ref [Node $ planet_info_node_type planet_info]
+ return ()
when (i < n) $
do _ <- makeDungeons planet_name (Beneath plane_ref) (succ i) planet_info
return ()
View
9 roguestar-engine/src/PlanetData.hs
@@ -28,7 +28,8 @@ data PlanetInfo = PlanetInfo {
planet_info_depth :: Integer,
planet_info_biome :: Biome,
planet_info_dungeon :: Biome,
- planet_info_town :: [(Rational,BuildingType)] }
+ planet_info_town :: [(Rational,BuildingType)],
+ planet_info_node_type :: NodeType }
deriving (Read,Show)
pgto :: Integer -> B.ByteString -> Biome -> PlanetInfo
@@ -41,9 +42,11 @@ pgto x name biome = PlanetInfo {
planet_info_biome = biome,
planet_info_dungeon = case () of
() | biome == OceanBiome -> AbyssalDungeon
+ () | biome == SwampBiome -> AbyssalDungeon
() | x == 1 -> ShallowDungeon
() -> DeepDungeon,
- planet_info_town = [(1,Portal)] }
+ planet_info_town = [(1,Portal)],
+ 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 }
@@ -63,7 +66,7 @@ pgto_planets = [
pgto 2 "pungo" ForestBiome,
pgto 2 "neuse" ForestBiome,
pgto 2 "crabtree" SwampBiome,
- pgto 2 "eno" SwampBiome `addTown` [(1%20,Monolith)],
+ pgto 2 "eno" SwampBiome `addTown` [(1%20,Node Monolith)],
pgto 2 "yadkin" SwampBiome,
pgto 2 "catawba" ForestBiome,
pgto 2 "pasquotank" ForestBiome,
View
2 roguestar-engine/src/Protocol.hs
@@ -393,7 +393,7 @@ dbDispatchQuery ["object-details",uid] = ro $
buildingToTableData (ref,Building) = objectTableWrapper ref $
do building_type <- buildingType ref
return $ "object-type building\n" `B.append`
- "building-type " `B.append` B.pack (show building_type) `B.append` "\n"
+ "building-type " `B.append` B.pack (showBuilding building_type) `B.append` "\n"
dbDispatchQuery ["player-stats","0"] = dbRequiresPlayerCenteredState dbQueryPlayerStats
View
2 roguestar-gl/roguestar-gl.cabal
@@ -47,7 +47,7 @@ Executable roguestar-gl
Models.Library, Models.MachineParts, Models.LibraryData, Models.Caduceator,
Models.Tree, Models.Encephalon, Models.PhaseWeapons, RenderingControl,
Keymaps.BuiltinKeymaps, Keymaps.CommonKeymap, Keymaps.NumpadKeymap,
- Keymaps.Keymaps, Keymaps.VIKeymap, AnimationBuildings, Models.Monolith,
+ Keymaps.Keymaps, Keymaps.VIKeymap, AnimationBuildings, Models.Node,
Models.Stargate, Statistics, Globals, Models.Sky, Scene, Models.Spheres,
Models.EnergySwords, Models.EnergyThings, Models.CyborgType4,
AnimationEvents, AnimationMenus, AnimationTerrain, AnimationTools,
View
2 roguestar-gl/src/Animation.hs
@@ -201,7 +201,7 @@ statusA = proc status_data ->
animstate_status_lines animstate }
Nothing -> animstate
--- | Number of dones. (A done is a message from the engine that an change has occured in the game world.)
+-- | Number of dones. (A done is a message from the engine that a change has occured in the game world.)
donesA :: (StateOf m ~ AnimationState,
InputOutputOf m ~ Enabled) =>
FRP e m () Integer
View
45 roguestar-gl/src/AnimationBuildings.hs
@@ -1,10 +1,13 @@
-{-# LANGUAGE Arrows, OverloadedStrings, TypeFamilies, FlexibleContexts #-}
+{-# LANGUAGE Arrows, OverloadedStrings, TypeFamilies, FlexibleContexts, RankNTypes #-}
module AnimationBuildings
(buildingAvatar)
where
import RSAGL.FRP
+import RSAGL.Math
+import RSAGL.Animation
+import RSAGL.Color.RSAGLColors
import Animation
import VisibleObject
import Models.LibraryData
@@ -14,23 +17,57 @@ import Scene
type BuildingAvatarSwitch m = AvatarSwitch () () m
type BuildingAvatar e m = FRP e (BuildingAvatarSwitch m) () ()
+-- | An avatar for a building. This function
+-- detects the type of a building based on the
+-- FRP Thread ID, and switches to the appropriate
+-- type of building avatar.
buildingAvatar :: (FRPModel m) => BuildingAvatar e m
buildingAvatar = proc () ->
do objectTypeGuard (== "building") -< ()
m_building_type <- objectDetailsLookup ThisObject "building-type" -< ()
switchContinue -< (fmap switchTo m_building_type,())
returnA -< ()
where switchTo "monolith" = simpleBuildingAvatar Monolith
+ switchTo "anchor" = planetaryAnchorAvatar
switchTo "portal" = simpleBuildingAvatar Portal
switchTo _ = questionMarkAvatar >>> arr (const ())
simpleBuildingAvatar :: (FRPModel m, LibraryModelSource lm) =>
lm -> BuildingAvatar e m
-simpleBuildingAvatar phase_weapon_model = proc () ->
+simpleBuildingAvatar building_model = genericBuildingAvatar $ proc () ->
+ do libraryA -< (scene_layer_local,building_model)
+ returnA -< ()
+
+genericBuildingAvatar :: (FRPModel m) =>
+ (forall x y. FRP e (FRP1Context x y (BuildingAvatarSwitch m)) () ()) ->
+ BuildingAvatar e m
+genericBuildingAvatar actionA = proc () ->
do visibleObjectHeader -< ()
m_orientation <- objectIdealOrientation ThisObject -< ()
- whenJust (transformA libraryA) -< fmap
- (\o -> (o,(scene_layer_local,phase_weapon_model))) m_orientation
+ whenJust (transformA actionA) -< fmap
+ (\o -> (o,())) m_orientation
returnA -< ()
+planetaryAnchorAvatar :: (FRPModel m) => BuildingAvatar e m
+planetaryAnchorAvatar = genericBuildingAvatar $ translate (Vector3D 0 1.0 0) $ proc () ->
+ do libraryA -< (scene_layer_local,PlanetaryAnchorCore)
+ planetaryAnchorFlange (1.1^1) (fromDegrees 25) (fromDegrees 30) 10.0 -< ()
+ planetaryAnchorFlange (1.1^2) (fromDegrees 50) (fromDegrees 60) 9.0 -< ()
+ planetaryAnchorFlange (1.1^3) (fromDegrees 75) (fromDegrees 90) 7.0 -< ()
+ planetaryAnchorFlange (1.1^4) (fromDegrees 100) (fromDegrees 120) 4.0 -< ()
+ planetaryAnchorFlange (1.1^5) (fromDegrees 125) (fromDegrees 150) 1.0 -< ()
+ accumulateSceneA -< (scene_layer_local,
+ lightSource $ PointLight (Point3D 0 1.0 0)
+ (measure (Point3D 0 1.0 0) (Point3D 1 0 1))
+ white
+ violet)
+
+planetaryAnchorFlange :: (FRPModel m, StateOf m ~ AnimationState, InputOutputOf m ~ Enabled) =>
+ RSdouble -> Angle -> Angle -> RSdouble -> FRP e m () ()
+planetaryAnchorFlange s rx rz x = scale' s $ proc () ->
+ do rotateA (Vector3D 0 1 0) (perSecond $ fromDegrees $ x*3.0) (rotate (Vector3D 0 0 1) rz $
+ rotateA (Vector3D 0 0 1) (perSecond $ fromDegrees $ x*7.0) (rotate (Vector3D 1 0 0) rx $
+ rotateA (Vector3D 1 0 0) (perSecond $ fromDegrees $ x*2.0) libraryA)) -<
+ (scene_layer_local,PlanetaryAnchorFlange)
+
View
4 roguestar-gl/src/Models/Library.hs
@@ -35,7 +35,7 @@ import Models.CyborgType4
import Models.EnergyThings
import Models.EnergySwords
import Models.Spheres
-import Models.Monolith
+import Models.Node
import Models.Stargate
-- |
@@ -80,6 +80,8 @@ toModel (SimpleModel CyborgType4HyperspaceStabilizer) =
toModel (EnergyThing EnergyCylinder c) = energyCylinder c
toModel (EnergyThing EnergySword c) = energySword c 3
toModel (SimpleModel Monolith) = monolith
+toModel (SimpleModel PlanetaryAnchorCore) = planetary_anchor_core
+toModel (SimpleModel PlanetaryAnchorFlange) = planetary_anchor_flange
toModel (SimpleModel Portal) = portal
-- |
View
2 roguestar-gl/src/Models/LibraryData.hs
@@ -48,6 +48,8 @@ data SimpleModel =
| CyborgType4HyperspaceStabilizer
-- Buildings
| Monolith
+ | PlanetaryAnchorCore
+ | PlanetaryAnchorFlange
| Portal
deriving (Eq,Ord,Show,Enum,Bounded)
View
15 roguestar-gl/src/Models/Monolith.hs
@@ -1,15 +0,0 @@
-module Models.Monolith
- (monolith)
- where
-
-import RSAGL.Math
-import RSAGL.Modeling
-import RSAGL.Color.RSAGLColors
-import Quality
-
-monolith :: Quality -> Modeling ()
-monolith _ =
- do box (Point3D (-1/2) 0 (-1/8)) (Point3D (1/2) (9/4) (1/8))
- material $
- do pigment $ pure blackbody
- specular 100 $ pure white
View
33 roguestar-gl/src/Models/Node.hs
@@ -0,0 +1,33 @@
+module Models.Node
+ (monolith,
+ planetary_anchor_core,
+ planetary_anchor_flange)
+ where
+
+import RSAGL.Math
+import RSAGL.Modeling
+import RSAGL.Color
+import RSAGL.Color.RSAGLColors
+import Quality
+
+monolith :: Quality -> Modeling ()
+monolith _ = model $
+ do box (Point3D (-1/2) 0 (-1/8)) (Point3D (1/2) (9/4) (1/8))
+ material $
+ do pigment $ pure blackbody
+ specular 100 $ pure white
+
+planetary_anchor_core :: Quality -> Modeling ()
+planetary_anchor_core _ = model $
+ do sphere (Point3D 0 0 0) 0.05
+ material $ emissive $ pure $ grayscale 0.75
+
+planetary_anchor_flange :: Quality -> Modeling ()
+planetary_anchor_flange _ = model $
+ do openDisc (Point3D 0 0 0)
+ (Vector3D 0 1 0)
+ 0.20
+ 0.21
+ material $ emissive $ pure violet
+ twoSided True
+

0 comments on commit 25168cb

Please sign in to comment.