Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

implemented object visibility

darcs-hash:20061015232854-7cce2-c00ded376926376d098ea7ed751a790de1c08b55.gz
  • Loading branch information...
commit 57c10e3a101ebbfc8d9e168e8d86187b0a12c81d 1 parent bf9e7c2
Christopher Lane Hinson authored
2  src/CreatureData.hs
View
@@ -44,7 +44,7 @@ import FactionData
data Creature = Creature { creature_stats :: Stats,
creature_attribs :: [CreatureAttribute],
creature_species_name :: String,
- creature_random_id :: Integer,
+ creature_random_id :: Integer, -- simply a random number attached to the creature, used by the gui to name the creature. It is NOT required to be unique, use the toUID function in DBData for this
creature_damage :: Integer,
creature_faction :: Faction }
deriving (Read,Show)
8 src/DB.hs
View
@@ -37,7 +37,6 @@ module DB
dbGetContentsFiltered,
dbGetCreatures,
dbGetCreaturesFiltered,
- toCoordinateLocationForm,
dbNextRandomInteger,
dbNextRandomIntegerStream,
dbSetStartingRace,
@@ -287,13 +286,6 @@ dbGetCreaturesFiltered item fnM =
else return False
-- |
--- Converts a list of a DBRef's children (as from dbGetContents) to only those elements
--- with (x,y) coordinates.
---
-toCoordinateLocationForm :: (DBRef a) => [(a,DBLocation)] -> [(a,(Integer,Integer))]
-toCoordinateLocationForm = mapMaybe (\ (dbref,loc) -> liftM ((,) dbref) $ toCoordinateLocation loc)
-
--- |
-- Generates and returns the next random Integer.
--
dbNextRandomInteger :: DB Integer
16 src/DBData.hs
View
@@ -25,6 +25,7 @@ module DBData
DBReference(..),
DBLocation(..),
toCoordinateLocation,
+ toCoordinateFacingLocation,
isCreatureRef,
isPlaneRef,
toCreatureRef,
@@ -67,18 +68,31 @@ toCoordinateLocation :: DBLocation -> Maybe (Integer,Integer)
toCoordinateLocation (DBCoordinateLocation xy) = Just xy
toCoordinateLocation (DBCoordinateFacingLocation (xy,_)) = Just xy
+-- |
+-- Converts a DBLocation to a location in ((x,y),facing) form, or nothing
+-- if there is no such valid interpretation of the DBLocation. DBLocations
+-- that contain only (x,y) coordinates will return with a facing of Here.
+--
+toCoordinateFacingLocation :: DBLocation -> Maybe ((Integer,Integer),Facing)
+toCoordinateFacingLocation (DBCoordinateLocation xy) = Just (xy,Here)
+toCoordinateFacingLocation (DBCoordinateFacingLocation xyf) = Just xyf
+
newtype CreatureRef = CreatureRef Integer deriving (Eq,Ord,Read,Show)
newtype PlaneRef = PlaneRef Integer deriving (Eq,Ord,Read,Show)
class DBRef a where
toDBReference :: a -> DBReference
+ toUID :: a -> Integer
instance DBRef DBReference where
toDBReference x = x
+ toUID (DBPlaneRef ref) = toUID ref
+ toUID (DBCreatureRef ref) = toUID ref
instance DBRef CreatureRef where
toDBReference x = DBCreatureRef x
+ toUID (CreatureRef x) = x
instance DBRef PlaneRef where
toDBReference x = DBPlaneRef x
-
+ toUID (PlaneRef x) = x
28 src/PlaneVisibility.hs
View
@@ -44,7 +44,7 @@ import Facing
-- Returns a list of all terrain patches that are visible to any creature belonging
-- to the specified faction on the specified plane.
--
-dbGetVisibleTerrainForFaction :: Faction -> PlaneRef -> DB [((Integer,Integer),TerrainPatch)]
+dbGetVisibleTerrainForFaction :: Faction -> PlaneRef -> DB [(TerrainPatch,(Integer,Integer))]
dbGetVisibleTerrainForFaction faction plane_ref =
do critters <- liftM (map fst) $ dbGetCreaturesFiltered plane_ref (filterByFaction faction)
liftM (Set.toList . Set.fromList . concat) $ mapM dbGetVisibleTerrainForCreature critters
@@ -52,7 +52,7 @@ dbGetVisibleTerrainForFaction faction plane_ref =
-- |
-- Returns a list of all terrain patches that are visible to the specified creature.
--
-dbGetVisibleTerrainForCreature :: CreatureRef -> DB [((Integer,Integer),TerrainPatch)]
+dbGetVisibleTerrainForCreature :: CreatureRef -> DB [(TerrainPatch,(Integer,Integer))]
dbGetVisibleTerrainForCreature creature_ref =
do loc <- dbGetPlanarLocation creature_ref
spot_check <- dbGetSpotCheck creature_ref
@@ -64,7 +64,7 @@ dbGetVisibleTerrainForCreature creature_ref =
-- Returns a list of all objects that are visible to any creature belonging
-- to the specified faction on the specified plane.
--
-dbGetVisibleObjectsForFaction :: Faction -> PlaneRef -> DB [(DBReference,(Integer,Integer))]
+dbGetVisibleObjectsForFaction :: Faction -> PlaneRef -> DB [DBReference]
dbGetVisibleObjectsForFaction faction plane_ref =
do critters <- liftM (map fst) $ dbGetCreaturesFiltered plane_ref (filterByFaction faction)
liftM (nub . concat) $ mapM dbGetVisibleObjectsForCreature critters
@@ -72,13 +72,16 @@ dbGetVisibleObjectsForFaction faction plane_ref =
-- |
-- Returns a list of all objects that are visible to the specified creature.
--
-dbGetVisibleObjectsForCreature :: CreatureRef -> DB [(DBReference,(Integer,Integer))]
+dbGetVisibleObjectsForCreature :: CreatureRef -> DB [DBReference]
dbGetVisibleObjectsForCreature creature_ref =
do loc <- dbGetPlanarLocation creature_ref
case loc of
- Just (plane_ref,_) -> filterM (dbIsPlanarVisibleTo creature_ref . fst) =<< (liftM toCoordinateLocationForm $ dbGetContents plane_ref)
+ Just (plane_ref,_) -> filterM (dbIsPlanarVisibleTo creature_ref) =<< (liftM (map fst) $ dbGetContents plane_ref)
Nothing -> return []
+-- |
+-- dbIsPlanarVisibleTo (a creature) (some object) is true if the creature can see the object.
+--
dbIsPlanarVisibleTo :: CreatureRef -> DBReference -> DB Bool
dbIsPlanarVisibleTo creature_ref obj_ref =
do creature_loc <- dbGetPlanarLocation creature_ref
@@ -99,10 +102,14 @@ dbGetHideCheck :: DBReference -> DB Integer
dbGetHideCheck (DBCreatureRef creature_ref) = liftM (creatureScore Hide) $ dbGetCreature creature_ref
dbGetHideCheck _ = return 0
-visibleTerrain :: (Integer,Integer) -> Integer -> TerrainMap -> [((Integer,Integer),TerrainPatch)]
+-- |
+-- visibleTerrain (creature's location) (spot check) (the terrain map) gives
+-- a list of visible terrain patches from that location with that spot check.
+--
+visibleTerrain :: (Integer,Integer) -> Integer -> TerrainMap -> [(TerrainPatch,(Integer,Integer))]
visibleTerrain creature_at@(creature_x,creature_y) spot_check terrain =
let max_range = maximumRangeForSpotCheck spot_check
- in map ( \ (x,y) -> ((x,y), gridAt terrain (x,y))) $
+ in map ( \ (x,y) -> (gridAt terrain (x,y),(x,y))) $
castRays creature_at
[terrainPatchBrightnessForm creature_at spot_check (creature_x+x,creature_y+y)
| x <- [-max_range..max_range],
@@ -110,10 +117,17 @@ visibleTerrain creature_at@(creature_x,creature_y) spot_check terrain =
x^2+y^2 <= max_range^2]
(terrainOpacity . gridAt terrain)
+-- |
+-- terrainPatchBrightnessForm (creature's location) (spot check) (terrain patch's location)
+-- gives (the patch's location,the patch's effective brightness) for the purpose of applying castRays.
+--
terrainPatchBrightnessForm :: (Integer,Integer) -> Integer -> (Integer,Integer) -> ((Integer,Integer),Integer)
terrainPatchBrightnessForm creature_at spot_check patch_at =
let delta_at = (fst creature_at - fst patch_at,snd creature_at - snd patch_at)
in (patch_at,spot_check - distanceCostForSight Here delta_at)
+-- |
+-- Returns true if the specified CreatureRef belongs to the specified Faction.
+--
filterByFaction :: Faction -> CreatureRef -> DB Bool
filterByFaction faction = liftM ((== faction) . creature_faction) . dbGetCreature
41 src/Protocol.hs
View
@@ -155,12 +155,36 @@ dbDispatch ["query","visible-terrain"] =
do maybe_plane_ref <- dbGetCurrentPlane
terrain_map <- maybe (return []) (dbGetVisibleTerrainForFaction Player) maybe_plane_ref
return ("begin-table visible-terrain 0 x y terrain-type\n" ++
- (unlines $ map (\ ((x,y),terrain_type) -> unwords [show x, show y, show terrain_type]) terrain_map) ++
+ (unlines $ map (\ (terrain_type,(x,y)) -> unwords [show x, show y, show terrain_type]) terrain_map) ++
"end-table")
dbDispatch ["query","visible-objects"] =
do maybe_plane_ref <- dbGetCurrentPlane
- FIXME HERE
+ objects <- maybe (return []) (dbGetVisibleObjectsForFaction Player) maybe_plane_ref
+ table_rows <- mapM dbObjectToTableRow objects
+ return ("begin-table visible-objects 0 object-unique-id x y facing\n" ++
+ (unlines $ table_rows) ++
+ "end-table")
+ where dbObjectToTableRow obj_ref =
+ do maybe_loc <- dbWhere obj_ref
+ return $ case (toCoordinateFacingLocation . snd =<< maybe_loc :: Maybe ((Integer,Integer),Facing))
+ of
+ Just ((x,y),facing) -> unwords [show $ toUID obj_ref,show x,show y,show facing]
+ Nothing -> ""
+
+dbDispatch ["query","object-details"] =
+ do maybe_plane_ref <- dbGetCurrentPlane
+ objects <- maybe (return []) (dbGetVisibleObjectsForFaction Player) maybe_plane_ref
+ liftM (concat . intersperse "\n") $ mapM dbObjectToTable objects
+ where dbObjectToTable obj_ref =
+ do table_data <- dbGetObjectTableData obj_ref
+ return ("begin-table object-details " ++ (show $ toUID obj_ref) ++ " property value\n" ++
+ table_data ++
+ "end-table")
+ dbGetObjectTableData (DBCreatureRef creature_ref) = liftM creatureToTableData $ dbGetCreature creature_ref
+ dbGetObjectTableData (DBPlaneRef _) = return "" -- implausible case
+ creatureToTableData creature = "object-type creature\n" ++
+ (concat $ map (\x -> fst x ++ " " ++ snd x ++ "\n") $ creatureStatsData creature)
dbDispatch ["action","select-race",race_name] =
dbRequiresRaceSelectionState $ dbSelectPlayerRace race_name
@@ -206,6 +230,9 @@ dbRerollRace _ = do starting_race <- dbGetStartingRace
dbQueryPlayerStats :: Creature -> DB String
dbQueryPlayerStats creature = return $ playerStatsTable creature
+-- |
+-- Information about player creatures (for which the player should have almost all available information.)
+--
playerStatsTable :: Creature -> String
playerStatsTable c =
"begin-table player-stats 0 property value\n" ++
@@ -224,6 +251,16 @@ playerStatsTable c =
"gender " ++ (show $ creatureGender c) ++ "\n" ++
"end-table"
+-- |
+-- Information about non-player creatures (for which there are very strict limits on what information
+-- the player can have). The result is in (Property,Value) form so that the result can easily be
+-- manipulated by the caller.
+--
+creatureStatsData :: Creature -> [(String,String)]
+creatureStatsData c = [("percent-hp",show $ (creatureScore HitPoints c * 100) `div` creatureScore MaxHitPoints c),
+ ("species",show $ creature_species_name c),
+ ("random-id",show $ creature_random_id c)]
+
dbQueryBaseClasses :: Creature -> DB String
dbQueryBaseClasses creature = return $ baseClassesTable creature
Please sign in to comment.
Something went wrong with that request. Please try again.