{-# LANGUAGE PatternGuards, FlexibleContexts, ScopedTypeVariables, RankNTypes #-}
module PlaneVisibility
(dbGetVisibleTerrainForFaction,
dbGetVisibleObjectsForFaction)
where
import FactionData
import DB
import TerrainData
import Plane
import PlaneData
import Control.Monad
import CreatureData
import Data.List
import Grids
import GridRayCaster
import VisibilityData
import Facing
import Data.Ratio
import Building
import Position
import Control.Applicative
dbGetSeersForFaction :: (DBReadable db) => Faction -> PlaneRef -> db [CreatureRef]
dbGetSeersForFaction faction plane_ref =
filterM (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) $ getPlanarPosition 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. Accepts a filter to
-- determine what kinds of objects will be tested..
--
dbGetVisibleObjectsForFaction :: (DBReadable db,GenericReference a S) => (forall m. DBReadable m => a -> m Bool) -> Faction -> PlaneRef -> db [a]
dbGetVisibleObjectsForFaction filterF faction plane_ref =
do critters <- dbGetSeersForFaction faction plane_ref
liftM (nubBy (=:=) . concat) $ mapRO (dbGetVisibleObjectsForCreature filterF) critters
-- |
-- Returns a list of all objects that are visible to the specified creature.
-- Accepts a filter to determine what kinds of objects will be tested.
--
dbGetVisibleObjectsForCreature :: (DBReadable db,GenericReference a S) => (forall m. DBReadable m => a -> m Bool) -> CreatureRef -> db [a]
dbGetVisibleObjectsForCreature filterF creature_ref =
do (loc :: Maybe PlaneRef) <- liftM (fmap location) $ getPlanarPosition creature_ref
case loc of
Just plane_ref -> filterRO (\a -> (&&) <$> filterF a <*> (dbIsPlanarVisible creature_ref $ generalizeReference a)) =<< dbGetContents plane_ref
Nothing -> return []
-- |
-- dbIsPlanarVisible (a creature) (some object) is true if the creature can see the object.
--
dbIsPlanarVisible :: (DBReadable db,ReferenceType a) => CreatureRef -> Reference a -> db Bool
dbIsPlanarVisible creature_ref obj_ref | creature_ref =:= obj_ref = return True
dbIsPlanarVisible creature_ref obj_ref =
do (creature_loc :: Maybe (PlaneRef,Position)) <- liftM (fmap location) $ getPlanarPosition creature_ref
(obj_loc :: Maybe (PlaneRef,MultiPosition)) <- liftM (fmap location) $ getPlanarPosition 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 (_,cp),Just (_,ops)) | distanceBetweenChessboard cp ops <= 1 -> return True --automatically see 8-adjacent objects
(Just (_,cp),Just (_,ops)) | distanceBetweenSquared cp ops > (maximumRangeForSpotCheck spot_check)^2 -> return False --cull objects that are too far away to ever be seen
(Just (c_plane,cp),Just (_,ops)) -> liftM or $ forM (positionPairs cp ops) $
\(Position (cx,cy),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 $ round $ (spot%1) * opposedLinearPowerRatio spot hide
dbGetSpotCheck :: (DBReadable db) => CreatureRef -> db Integer
dbGetSpotCheck creature_ref = liftM (creatureAbilityScore SpotSkill) $ dbGetCreature creature_ref
dbGetHideCheck :: (DBReadable db) => Reference a -> db Integer
dbGetHideCheck ref | Just creature_ref <- coerceReferenceTyped _creature ref = liftM (creatureAbilityScore HideSkill) $ dbGetCreature creature_ref
dbGetHideCheck ref | Just building_ref <- coerceReferenceTyped _building ref = liftM negate $ buildingSize building_ref
dbGetHideCheck _ | otherwise = 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 -> TerrainGrid -> [(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