Permalink
Browse files

creatures can be in planes, with line of sight rules

darcs-hash:20060911034713-7cce2-b9bbd21ee1b8736cb83015843da5e1bff176b4fd.gz
  • Loading branch information...
1 parent 78e15c0 commit 583286a662d12f410c3524be9f2343fca91ad7f8 @clanehin committed Sep 11, 2006
Showing with 633 additions and 50 deletions.
  1. +32 −3 src/BeginGame.hs
  2. +19 −14 src/Creature.hs
  3. +10 −2 src/CreatureData.hs
  4. +74 −3 src/DB.hs
  5. +27 −2 src/DBData.hs
  6. +15 −0 src/FactionData.hs
  7. +120 −0 src/GridRayCaster.hs
  8. +19 −3 src/InsidenessMap.hs
  9. +3 −1 src/Main.hs
  10. +80 −11 src/Plane.hs
  11. +2 −3 src/PlaneData.hs
  12. +55 −0 src/PlaneVisibility.hs
  13. +43 −3 src/Protocol.hs
  14. +18 −4 src/TerrainData.hs
  15. +5 −1 src/Tests.hs
  16. +111 −0 src/VisibilityData.hs
View
@@ -2,15 +2,44 @@ module BeginGame
(dbBeginGame)
where
---import Creature
+import Plane
import CreatureData
+import Character
import CharacterData
---import Character
import DB
+import DBData
+import TerrainData
+import Data.Maybe
+
+player_race_to_biome :: [(String,Biome)]
+player_race_to_biome =
+ [("anachronid",DeasertBiome),
+ ("androsynth",RockBiome),
+ ("ascendant",MountainBiome),
+ ("canduceator",SwampBiome),
+ ("encephalon",SwampBiome),
+ ("goliath",DeasertBiome),
+ ("hellion",GrasslandBiome),
+ ("kraken",OceanBiome),
+ ("myrmidon",DeasertBiome),
+ ("perennial",ForestBiome),
+ ("recreant",DeasertBiome),
+ ("reptilian",SwampBiome)]
+
+dbCreateStartingPlane :: Creature -> DB PlaneRef
+dbCreateStartingPlane creature =
+ dbNewPlane $ TerrainGenerationData {tg_smootheness = 5,
+ tg_biome = fromMaybe GrasslandBiome $ lookup (creature_species_name creature) player_race_to_biome}
-- |
-- Begins the game with the specified starting player creature and the specified starting character class.
-- The character class should not be pre-applied to the creature.
--
dbBeginGame :: Creature -> CharacterClass -> DB ()
-dbBeginGame _ _ = return ()
+dbBeginGame creature character_class =
+ do let first_level_creature = applyCharacterClass character_class creature
+ creature_ref <- dbAddCreature first_level_creature
+ plane_ref <- dbCreateStartingPlane creature
+ landing_site <- pickRandomClearSite 200 30 2 plane_ref
+ dbMoveInto plane_ref creature_ref (DBCoordinateLocation landing_site)
+ dbSetState $ DBPlayerCreatureTurn creature_ref
View
@@ -33,6 +33,7 @@ import Species
import Tests
import DBData
import Dice
+import FactionData
runCreatureGenerationTest :: IO ()
runCreatureGenerationTest = do db0 <- initialDB
@@ -41,30 +42,34 @@ runCreatureGenerationTest = do db0 <- initialDB
-- |
-- Generates a new Creature from the specified species.
--
-newCreature :: Species -> DB Creature
-newCreature species = do (stats,attribs,name) <- generateCreatureData species
- random_id <- 1 `d` 2000
- return (Creature { creature_stats=stats,
- creature_attribs=attribs,
- creature_species_name=name,
- creature_random_id=random_id,
- creature_damage=0 })
+dbGenerateCreature :: Faction -> Species -> DB Creature
+dbGenerateCreature faction species =
+ do (stats,attribs,name) <- generateCreatureData species
+ random_id <- 1 `d` 2000
+ return (Creature { creature_stats=stats,
+ creature_attribs=attribs,
+ creature_species_name=name,
+ creature_random_id=random_id,
+ creature_damage=0,
+ creature_faction=faction})
-- |
-- During DBRaceSelectionState, generates a new Creature for the player character and sets it into the
-- database's DBClassSelectionState.
--
dbGenerateInitialPlayerCreature :: Species -> DB ()
-dbGenerateInitialPlayerCreature species = do newc <- newCreature species
- dbSetStartingRace species
- dbSetState (DBClassSelectionState newc)
+dbGenerateInitialPlayerCreature species =
+ do newc <- dbGenerateCreature Player species
+ dbSetStartingRace species
+ dbSetState (DBClassSelectionState newc)
-- |
-- Generates a new Creature from the specified Species and adds it to the database.
--
-dbNewCreature :: Species -> DB CreatureRef
-dbNewCreature species = do newc <- newCreature species
- dbAddCreature newc
+dbNewCreature :: Faction -> Species -> DB CreatureRef
+dbNewCreature faction species =
+ do newc <- dbGenerateCreature faction species
+ dbAddCreature newc
creatureTests :: [TestCase]
creatureTests = [testHitPointCalculation,testAlive,testDead,
View
@@ -39,12 +39,14 @@ import Alignment
import StatsData
import ListUtils (count)
import Data.Maybe
+import FactionData
data Creature = Creature { creature_stats :: Stats,
creature_attribs :: [CreatureAttribute],
creature_species_name :: String,
creature_random_id :: Integer,
- creature_damage :: Integer }
+ creature_damage :: Integer,
+ creature_faction :: Faction }
deriving (Read,Show)
instance StatisticsBlock Creature where
@@ -105,6 +107,8 @@ data Score = MaxHitPoints
| RangedDamage
| Speed
| EffectiveLevel
+ | Spot
+ | Hide
-- |
-- An example creature used for test cases.
@@ -121,7 +125,8 @@ exampleCreature1 = Creature
RangedDefenseSkill],
creature_species_name = "Example-Creature-1",
creature_random_id=0,
- creature_damage = 0 }
+ creature_damage = 0,
+ creature_faction = MonstersInc }
creatureScore :: Score -> Creature -> Integer
creatureScore MaxHitPoints = \c -> max 6 (20 + (str c) + (con c) + (dex c) + (mind c)) + 2 * attributeCount ToughnessTrait c
@@ -134,6 +139,9 @@ creatureScore RangedAttack = statPlusDouble Perception RangedAttackSkill
creatureScore RangedDefense = statPlusDouble Perception RangedDefenseSkill
creatureScore RangedDamage = \c -> max 0 $ per c + attributeCount PreciseShot c
creatureScore Speed = \c -> 20 + attributeCount SpeedTrait c
+creatureScore Spot = statPlusDouble Perception SpotSkill
+creatureScore Hide = statPlusDouble Perception HideSkill
+
-- |
-- The creature's effective level.
--
View
@@ -29,6 +29,14 @@ module DB
dbAddPlane,
dbGetCreature,
dbGetPlane,
+ dbModCreature,
+ dbModPlane,
+ dbMoveInto,
+ dbWhere,
+ dbGetContents,
+ dbGetContentsFiltered,
+ dbGetCreatures,
+ dbGetCreaturesFiltered,
dbNextRandomInteger,
dbNextRandomIntegerStream,
dbSetStartingRace,
@@ -42,11 +50,13 @@ import Control.Monad.State
import System.Time
import RNG
import Data.Map as Map
+import Data.List as List
import InsidenessMap
import SpeciesData
data DBState = DBRaceSelectionState
| DBClassSelectionState Creature
+ | DBPlayerCreatureTurn CreatureRef
deriving (Read,Show)
-- |
@@ -141,9 +151,9 @@ dbSetState state = do db0 <- get
--
dbNextObjectRef :: DB Integer
dbNextObjectRef = do db <- get
- let result = db_next_object_ref db
- in do put (db { db_next_object_ref=(succ result) })
- return result
+ result <- return $ db_next_object_ref db
+ put (db { db_next_object_ref=(succ result) })
+ return result
-- |
-- Adds something to a map in the database using a new object reference.
@@ -203,6 +213,67 @@ dbGetCreature = dbGetObjectComposable db_creatures
dbGetPlane :: PlaneRef -> DB Plane
dbGetPlane = dbGetObjectComposable db_planes
+-- |
+-- Modifies an Object based on an ObjectRef.
+--
+dbModObjectComposable :: DBRef ref => (ref -> DB a) -> ((ref,a) -> DB ()) -> (a -> a) -> ref -> DB ()
+dbModObjectComposable get_fn put_fn mod_fn ref =
+ do x0 <- get_fn ref
+ put_fn (ref,mod_fn x0)
+
+-- |
+-- Modifies a Plane based on a PlaneRef.
+--
+dbModPlane :: (Plane -> Plane) -> PlaneRef -> DB ()
+dbModPlane = dbModObjectComposable dbGetPlane dbPutPlane
+
+-- |
+-- Modifies a Creature based on a PlaneRef.
+--
+dbModCreature :: (Creature -> Creature) -> CreatureRef -> DB ()
+dbModCreature = dbModObjectComposable dbGetCreature dbPutCreature
+
+-- |
+-- Moves the first object into the second.
+--
+dbMoveInto :: (DBRef a,DBRef b) => a -> b -> DBLocation -> DB ()
+dbMoveInto container item location =
+ do db <- get
+ imap <- return $ db_inside db
+ put $ db { db_inside=InsidenessMap.insert (toDBReference container,toDBReference item,location) imap }
+
+-- |
+-- Returns the (parent,object's location) of this object.
+--
+dbWhere :: (DBRef a) => a -> DB (Maybe (DBReference,DBLocation))
+dbWhere item = liftM (InsidenessMap.lookup (toDBReference item) . db_inside) $ get
+
+-- |
+-- Returns the children [(child,child's location)] of this object.
+--
+dbGetContents :: (DBRef a) => a -> DB [(DBReference,DBLocation)]
+dbGetContents item = liftM (Prelude.map (\(_,y,z) -> (y,z)) . InsidenessMap.children (toDBReference item) . db_inside) get
+
+dbGetContentsFiltered :: (DBRef a) => a -> (DBReference -> DB Bool) -> DB [(DBReference,DBLocation)]
+dbGetContentsFiltered item fnM =
+ filterM fnM' =<< dbGetContents item
+ where fnM' (ref,_) = fnM ref
+
+-- |
+-- Returns all the CreatureRefs for Creatures inside this item.
+--
+dbGetCreatures :: (DBRef a) => a -> DB [(CreatureRef,DBLocation)]
+dbGetCreatures item = dbGetCreaturesFiltered item (\_ -> return True)
+
+dbGetCreaturesFiltered :: (DBRef a) => a -> (CreatureRef -> DB Bool) -> DB [(CreatureRef,DBLocation)]
+dbGetCreaturesFiltered item fnM =
+ liftM (List.map ( \ x -> (toCreatureRef $ fst x,snd x))) $
+ dbGetContentsFiltered item fnM'
+ where fnM' x = if isCreatureRef x
+ then fnM $ toCreatureRef x
+ else return False
+
+
-- |
-- Generates and returns the next random Integer.
--
View
@@ -23,21 +23,46 @@ module DBData
PlaneRef(..),
DBRef(..),
DBReference(..),
- DBLocation(..))
+ DBLocation(..),
+ isCreatureRef,
+ isPlaneRef,
+ toCreatureRef,
+ toPlaneRef)
where
data DBReference = DBCreatureRef CreatureRef
| DBPlaneRef PlaneRef
deriving (Eq,Ord,Read,Show)
+isCreatureRef :: DBReference -> Bool
+isCreatureRef (DBCreatureRef {}) = True
+isCreatureRef _ = False
+
+isPlaneRef :: DBReference -> Bool
+isPlaneRef (DBCreatureRef {}) = True
+isPlaneRef _ = False
+
+toCreatureRef :: (DBRef a) => a -> CreatureRef
+toCreatureRef x = case toDBReference x of
+ DBCreatureRef creature_ref -> creature_ref
+ _ -> error "not a DBCreatureRef"
+
+toPlaneRef :: (DBRef a) => a -> PlaneRef
+toPlaneRef x = case toDBReference x of
+ DBPlaneRef plane_ref -> plane_ref
+ _ -> error "not a DBPlaneRef"
+
data DBLocation = DBCoordinateLocation (Integer,Integer)
deriving (Read,Show)
newtype CreatureRef = CreatureRef Integer deriving (Eq,Ord,Read,Show)
newtype PlaneRef = PlaneRef Integer deriving (Eq,Ord,Read,Show)
class DBRef a where
- toDBReference :: (DBRef a) => a -> DBReference
+ toDBReference :: a -> DBReference
+
+instance DBRef DBReference where
+ toDBReference x = x
instance DBRef CreatureRef where
toDBReference x = DBCreatureRef x
View
@@ -0,0 +1,15 @@
+module FactionData
+ (Faction(..))
+ where
+
+data Faction = Player
+ | InterstellarConcordance -- the lawful galactic government
+ | PanGalacticTreatyOrganization -- the neutral galactic government
+ | ImperialAlliance -- the chaotic galactic government
+ | MonstersInc -- nonsentient monsters
+ | Nonaligned -- pirates, mecenaries, your friendly neighborhood police office, etc
+ | Cyborgs -- cyborgs
+ | Whispers -- the dark indifferent destroyers of worlds
+ | Proselytes -- evil entities that possess others' minds
+ | Civilian -- merchants, children -- don't kill these
+ deriving (Eq,Read,Show)
Oops, something went wrong.

0 comments on commit 583286a

Please sign in to comment.