about summary refs log tree commit diff
path: root/src/Xanthous/Data/EntityMap/Graphics.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xanthous/Data/EntityMap/Graphics.hs')
-rw-r--r--src/Xanthous/Data/EntityMap/Graphics.hs44
1 files changed, 30 insertions, 14 deletions
diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs
index 9dcc02b8e88f..3124c6a334cc 100644
--- a/src/Xanthous/Data/EntityMap/Graphics.hs
+++ b/src/Xanthous/Data/EntityMap/Graphics.hs
@@ -3,9 +3,10 @@
 module Xanthous.Data.EntityMap.Graphics
   ( visiblePositions
   , visibleEntities
+  , linesOfSight
   ) where
 --------------------------------------------------------------------------------
-import Xanthous.Prelude
+import Xanthous.Prelude hiding (lines)
 --------------------------------------------------------------------------------
 import Xanthous.Util (takeWhileInclusive)
 import Xanthous.Data
@@ -14,22 +15,37 @@ import Xanthous.Entities
 import Xanthous.Util.Graphics (circle, line)
 --------------------------------------------------------------------------------
 
-visiblePositions :: Position -> Word -> EntityMap SomeEntity -> Set Position
+visiblePositions :: Entity e => Position -> Word -> EntityMap e -> Set Position
 visiblePositions pos radius = setFromList . positions . visibleEntities pos radius
 
-
--- | Given a point and a radius of vision, returns a list of all entities that
--- are *visible* (eg, not blocked by an entity that obscures vision) from that
--- point
-visibleEntities :: Position -> Word -> EntityMap SomeEntity -> EntityMap SomeEntity
-visibleEntities (view _Position -> pos) visionRadius em
-  = fromEIDsAndPositioned . fold . fold $ sightAdjustedLines
+-- | Returns a list of individual lines of sight, each of which is a list of
+-- entities at positions on that line of sight
+linesOfSight
+  :: forall e. Entity e
+  => Position
+  -> Word
+  -> EntityMap e
+  -> [[(Position, Vector (EntityID, e))]]
+linesOfSight (view _Position -> pos) visionRadius em
+  = entitiesOnLines
+  <&> takeWhileInclusive (none (blocksVision . snd) . snd)
   where
-    -- I love laziness!
     radius = circle pos $ fromIntegral visionRadius
-    linesOfSight = radius <&> line pos
-    entitiesOnLines = linesOfSight <&> map getPositionedAt
-    sightAdjustedLines = entitiesOnLines <&> takeWhileInclusive (none $ blocksVision . snd)
+    lines = line pos <$> radius
+    entitiesOnLines :: [[(Position, Vector (EntityID, e))]]
+    entitiesOnLines = lines <&> map getPositionedAt
+    getPositionedAt :: (Int, Int) -> (Position, Vector (EntityID, e))
     getPositionedAt p =
       let ppos = _Position # p
-      in atPositionWithIDs ppos em
+      in (ppos, over _2 (view positioned) <$> atPositionWithIDs ppos em)
+
+-- | Given a point and a radius of vision, returns a list of all entities that
+-- are *visible* (eg, not blocked by an entity that obscures vision) from that
+-- point
+visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e
+visibleEntities pos visionRadius
+  = fromEIDsAndPositioned
+  . fold
+  . map (\(p, es) -> over _2 (Positioned p) <$> es)
+  . fold
+  . linesOfSight pos visionRadius