{-# LANGUAGE PatternGuards, FlexibleContexts #-}
module PlaneVisibility
(dbGetVisibleTerrainForFaction,
dbGetVisibleObjectsForFaction)
where
import FactionData
import DB
import TerrainData
import Plane
import PlaneData
import Control.Monad
import CreatureData
import Data.Maybe
import Data.List
import Grids
import GridRayCaster
import VisibilityData
import Facing
import Data.Ratio
dbGetSeersForFaction :: (DBReadable db) => Faction -> PlaneRef -> db [CreatureRef]
dbGetSeersForFaction faction plane_ref =
filterRO (filterByFaction faction) =<< dbGetContents plane_ref
-- |
-- Returns a list of all terrain patches that are visible to any creature belonging
-- to the specified faction on the specified plane.
--
dbGetVisibleTerrainForFaction :: (DBReadable db) => Faction -> PlaneRef ->
db [(TerrainPatch,Position)]
dbGetVisibleTerrainForFaction faction plane_ref =
do critters <- dbGetSeersForFaction faction plane_ref
liftM (nub . concat) $ mapRO dbGetVisibleTerrainForCreature critters
-- |
-- Returns a list of all terrain patches that are visible to the specified creature.
--
dbGetVisibleTerrainForCreature :: (DBReadable db) => CreatureRef -> db [(TerrainPatch,Position)]
dbGetVisibleTerrainForCreature creature_ref =
do loc <- liftM (fmap location) $ getPlanarLocation creature_ref
spot_check <- dbGetSpotCheck creature_ref
case loc of
Just (plane_ref,creature_at) -> liftM (visibleTerrain creature_at spot_check . plane_terrain) $ dbGetPlane 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 :: (DBReadable db,GenericReference a S) => Faction -> PlaneRef -> db [a]
dbGetVisibleObjectsForFaction faction plane_ref =
do critters <- dbGetSeersForFaction faction plane_ref
liftM (nubBy (=:=) . concat) $ mapM dbGetVisibleObjectsForCreature critters
-- |
-- Returns a list of all objects that are visible to the specified creature.
--
dbGetVisibleObjectsForCreature :: (DBReadable db,GenericReference a S) => CreatureRef -> db [a]
dbGetVisibleObjectsForCreature creature_ref =
do loc <- liftM (fmap location) $ getPlanarLocation creature_ref
case loc of
Just (plane_ref,_) -> filterRO (dbIsPlanarVisibleTo creature_ref . generalizeReference) =<< dbGetContents plane_ref
Nothing -> return []
-- |
-- dbIsPlanarVisibleTo (a creature) (some object) is true if the creature can see the object.
--
dbIsPlanarVisibleTo :: (DBReadable db,ReferenceType a) => CreatureRef -> Reference a -> db Bool
dbIsPlanarVisibleTo creature_ref obj_ref | creature_ref =:= obj_ref = return True
dbIsPlanarVisibleTo creature_ref obj_ref =
do creature_loc <- liftM (fmap location) $ getPlanarLocation creature_ref
obj_loc <- liftM (fmap location) $ getPlanarLocation obj_ref
spot_check <- dbGetOpposedSpotCheck creature_ref 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 --never see objects on different planes
(Just (_,Position (cx,cy)),Just (_,Position (ox,oy))) | abs (cx-ox) <= 1 && abs (cy-oy) <= 1 -> return True --automatically see 8-adjacent objects
(Just (_,Position (cx,cy)),Just (_,Position (ox,oy))) | (ox-cx)^2+(oy-cy)^2 > (maximumRangeForSpotCheck spot_check)^2 -> return False --cull objects that are too far away to ever be seen
(Just (c_plane,Position (cx,cy)),Just (_,Position (ox,oy))) ->
do let delta_at = (ox-cx,oy-cy)
terrain <- liftM plane_terrain $ dbGetPlane c_plane -- falling through all other tests, cast a ray for visibility
return $ castRay (cx,cy) (ox,oy) (spot_check - distanceCostForSight Here delta_at) (terrainOpacity . gridAt terrain)
dbGetOpposedSpotCheck :: (DBReadable db) => CreatureRef -> Reference a -> db Integer
dbGetOpposedSpotCheck creature_ref object_ref =
do spot <- dbGetSpotCheck creature_ref
hide <- dbGetHideCheck object_ref
return $ spot * (round $ min 1 $ spot % hide)
dbGetSpotCheck :: (DBReadable db) => CreatureRef -> db Integer
dbGetSpotCheck creature_ref = liftM (creatureScore Spot) $ dbGetCreature creature_ref
dbGetHideCheck :: (DBReadable db) => Reference a -> db Integer
dbGetHideCheck ref | Just creature_ref <- coerceReferenceTyped _creature ref = liftM (creatureScore Hide) $ dbGetCreature creature_ref
dbGetHideCheck _ = return 1
-- |
-- visibleTerrain (creature's location) (spot check) (the terrain map) gives
-- a list of visible terrain patches from that location with that spot check.
--
visibleTerrain :: Position -> Integer -> TerrainMap -> [(TerrainPatch,Position)]
visibleTerrain (Position (creature_at@(creature_x,creature_y))) spot_check terrain =
let max_range = maximumRangeForSpotCheck spot_check
in map (\(x,y) -> (gridAt terrain (x,y),Position (x,y))) $
castRays creature_at
[terrainPatchBrightnessForm creature_at spot_check (creature_x+x,creature_y+y)
| x <- [-max_range..max_range],
y <- [-max_range..max_range],
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 :: (DBReadable db) => Faction -> CreatureRef -> db Bool
filterByFaction faction = liftM ((== faction) . creature_faction) . dbGetCreature