Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

working on object-object visibility rules (broken)

darcs-hash:20060926221606-7cce2-99815ffce7a29b45012ab46dd896dcd6eb7728e6.gz
  • Loading branch information...
commit bf9e7c20585c7225e7aed95139e74faa1f247fc8 1 parent b502a08
Christopher Lane Hinson authored
8 src/DB.hs
View
@@ -37,6 +37,7 @@ module DB
dbGetContentsFiltered,
dbGetCreatures,
dbGetCreaturesFiltered,
+ toCoordinateLocationForm,
dbNextRandomInteger,
dbNextRandomIntegerStream,
dbSetStartingRace,
@@ -54,6 +55,7 @@ import Data.Map as Map
import Data.List as List
import InsidenessMap
import SpeciesData
+import Data.Maybe
data DBState = DBRaceSelectionState
| DBClassSelectionState Creature
@@ -284,6 +286,12 @@ dbGetCreaturesFiltered item fnM =
then fnM $ toCreatureRef x
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.
9 src/DBData.hs
View
@@ -24,6 +24,7 @@ module DBData
DBRef(..),
DBReference(..),
DBLocation(..),
+ toCoordinateLocation,
isCreatureRef,
isPlaneRef,
toCreatureRef,
@@ -58,6 +59,14 @@ data DBLocation = DBCoordinateLocation (Integer,Integer)
| DBCoordinateFacingLocation ((Integer,Integer),Facing)
deriving (Read,Show)
+-- |
+-- Converts a DBLocation to a location in (x,y) form, or nothing if there is
+-- no valid (x,y) interpretation of the DBLocation.
+--
+toCoordinateLocation :: DBLocation -> Maybe (Integer,Integer)
+toCoordinateLocation (DBCoordinateLocation xy) = Just xy
+toCoordinateLocation (DBCoordinateFacingLocation (xy,_)) = Just xy
+
newtype CreatureRef = CreatureRef Integer deriving (Eq,Ord,Read,Show)
newtype PlaneRef = PlaneRef Integer deriving (Eq,Ord,Read,Show)
1  src/Plane.hs
View
@@ -45,6 +45,7 @@ dbGetPlanarLocation object_ref =
do parent_info <- dbWhere object_ref
case parent_info of
Just (DBPlaneRef plane_ref,DBCoordinateLocation location) -> return $ Just (plane_ref,location)
+ Just (DBPlaneRef plane_ref,DBCoordinateFacingLocation location) -> return $ Just (plane_ref,fst location)
Just (someplace,_) -> dbGetPlanarLocation someplace
Nothing -> return Nothing
58 src/PlaneVisibility.hs
View
@@ -20,7 +20,8 @@
module PlaneVisibility
(dbGetVisibleTerrainForFaction,
- dbGetVisibleTerrainForCreature)
+ dbGetVisibleTerrainForCreature,
+ dbGetVisibleObjectsForFaction)
where
import FactionData
@@ -37,21 +38,67 @@ import Grids
import GridRayCaster
import VisibilityData
import Data.Set as Set (fromList,toList)
+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 plane_ref =
- do critters <- liftM (map fst) $ dbGetCreaturesFiltered plane_ref filterByFaction
+ do critters <- liftM (map fst) $ dbGetCreaturesFiltered plane_ref (filterByFaction faction)
liftM (Set.toList . Set.fromList . concat) $ mapM dbGetVisibleTerrainForCreature critters
- where filterByFaction = liftM ((== faction) . creature_faction) . dbGetCreature
+-- |
+-- Returns a list of all terrain patches that are visible to the specified creature.
+--
dbGetVisibleTerrainForCreature :: CreatureRef -> DB [((Integer,Integer),TerrainPatch)]
dbGetVisibleTerrainForCreature creature_ref =
do loc <- dbGetPlanarLocation creature_ref
- spot_check <- liftM (creatureScore Spot) $ dbGetCreature creature_ref
+ spot_check <- dbGetSpotCheck creature_ref
case loc of
Just (plane_ref,creature_at) -> liftM (visibleTerrain creature_at spot_check . plane_terrain) $ dbGetInstancedPlane plane_ref
Nothing -> return []
+-- |
+-- 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 plane_ref =
+ do critters <- liftM (map fst) $ dbGetCreaturesFiltered plane_ref (filterByFaction faction)
+ liftM (nub . concat) $ mapM dbGetVisibleObjectsForCreature critters
+
+-- |
+-- Returns a list of all objects that are visible to the specified creature.
+--
+dbGetVisibleObjectsForCreature :: CreatureRef -> DB [(DBReference,(Integer,Integer))]
+dbGetVisibleObjectsForCreature creature_ref =
+ do loc <- dbGetPlanarLocation creature_ref
+ case loc of
+ Just (plane_ref,_) -> filterM (dbIsPlanarVisibleTo creature_ref . fst) =<< (liftM toCoordinateLocationForm $ dbGetContents plane_ref)
+ Nothing -> return []
+
+dbIsPlanarVisibleTo :: CreatureRef -> DBReference -> DB Bool
+dbIsPlanarVisibleTo creature_ref obj_ref =
+ do creature_loc <- dbGetPlanarLocation creature_ref
+ obj_loc <- dbGetPlanarLocation obj_ref
+ spot_check <- liftM2 (-) (dbGetSpotCheck creature_ref) (dbGetHideCheck obj_ref)
+ case (creature_loc,obj_loc) of
+ (Nothing,_) -> return False
+ (_,Nothing) -> return False
+ (Just (c_plane,_),Just (o_plane,_)) | c_plane /= o_plane -> return False
+ (Just (_,(cx,cy)),Just (_,(ox,oy))) | (ox-cx)^2+(oy-cy)^2 > maximumRangeForSpotCheck spot_check -> return False
+ (Just (c_plane,c_at),Just (_,o_at)) -> do terrain <- liftM plane_terrain $ dbGetInstancedPlane c_plane
+ return $ castRay c_at o_at spot_check (terrainOpacity . gridAt terrain)
+
+dbGetSpotCheck :: CreatureRef -> DB Integer
+dbGetSpotCheck creature_ref = liftM (creatureScore Spot) $ dbGetCreature creature_ref
+
+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_at@(creature_x,creature_y) spot_check terrain =
let max_range = maximumRangeForSpotCheck spot_check
@@ -67,3 +114,6 @@ terrainPatchBrightnessForm :: (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)
+
+filterByFaction :: Faction -> CreatureRef -> DB Bool
+filterByFaction faction = liftM ((== faction) . creature_faction) . dbGetCreature
8 src/Protocol.hs
View
@@ -158,6 +158,10 @@ dbDispatch ["query","visible-terrain"] =
(unlines $ map (\ ((x,y),terrain_type) -> unwords [show x, show y, show terrain_type]) terrain_map) ++
"end-table")
+dbDispatch ["query","visible-objects"] =
+ do maybe_plane_ref <- dbGetCurrentPlane
+ FIXME HERE
+
dbDispatch ["action","select-race",race_name] =
dbRequiresRaceSelectionState $ dbSelectPlayerRace race_name
@@ -240,7 +244,7 @@ dbQueryCenterCoordinates creature_ref =
Just (DBCoordinateFacingLocation ((x,y),facing)) -> return (begin_table ++
"x " ++ show x ++ "\n" ++
"y " ++ show y ++ "\n" ++
- "facing " ++ show facing ++ "\n " ++
+ "facing " ++ show facing ++ "\n" ++
"end-table")
_ -> return (begin_table ++ "end-table")
- where begin_table = "begin-table center-coordinates 0 axis coordinate\n"
+ where begin_table = "begin-table center-coordinates 0 axis coordinate\n"
8 src/VisibilityData.hs
View
@@ -19,18 +19,16 @@
--------------------------------------------------------------------------
module VisibilityData
- (Facing(..),
- distanceCostForSight,
+ (distanceCostForSight,
terrainHideMultiplier,
terrainSpotMultiplier,
terrainOpacity,
- facingToRelative7,
maximumRangeForSpotCheck)
where
import TerrainData
import Data.List
-
+import Facing
-- |
-- We multiply a creature's hide check by this number if it is standing on this terrain.
@@ -66,7 +64,7 @@ terrainSpotMultiplier _ = 1
-- interferes with vision.
--
terrainOpacity :: TerrainPatch -> Integer
-terrainOpacity RockFace = 100
+terrainOpacity RockFace = 15
terrainOpacity Rubble = 1
terrainOpacity (Ore {}) = 1
terrainOpacity RockyGround = 0
Please sign in to comment.
Something went wrong with that request. Please try again.