2 files changed, 42 insertions, 14 deletions
diff --git a/src/Xanthous/Data/EntityMap.hs b/src/Xanthous/Data/EntityMap.hs
index 7885839d51b0..5b5e8a063f2c 100644
--- a/src/Xanthous/Data/EntityMap.hs
+++ b/src/Xanthous/Data/EntityMap.hs
@@ -14,6 +14,7 @@ module Xanthous.Data.EntityMap
   , insertAt
   , insertAtReturningID
   , fromEIDsAndPositioned
+  , toEIDsAndPositioned
   , atPosition
   , atPositionWithIDs
   , positions
@@ -101,6 +102,14 @@ instance Semigroup (EntityMap a) where
 instance Monoid (EntityMap a) where
   mempty = emptyEntityMap
 
+instance FunctorWithIndex EntityID EntityMap
+
+instance FoldableWithIndex EntityID EntityMap
+
+instance TraversableWithIndex EntityID EntityMap where
+  itraversed = byID . itraversed . rmap sequenceA . distrib
+  itraverse = itraverseOf itraversed
+
 emptyEntityMap :: EntityMap a
 emptyEntityMap = EntityMap mempty mempty 0
 
@@ -183,6 +192,9 @@ fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty
       .~ fromMaybe 1
          (maximumOf (ifolded . asIndex) (em ^. byID))
 
+toEIDsAndPositioned :: EntityMap a -> [(EntityID, Positioned a)]
+toEIDsAndPositioned = itoListOf $ byID . ifolded
+
 positions :: EntityMap a -> [Position]
 positions = toListOf $ byPosition . to keys . folded
 
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