about summary refs log tree commit diff
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2020-05-10T23·50-0400
committerGriffin Smith <root@gws.fyi>2020-05-10T23·50-0400
commit9ec51e51234b0c9ace93091d9071d932cf819f1f (patch)
treedbf2d63b69f16055c79b22b1f3f94b5ad31cac8d
parent2320cfa8cd2540cd0caf91f2e7cdc81045c9504c (diff)
Entities inside a wall can't see anything
The test for "one step in each cardinal direction is always visible" was
giving a false-negative for an entity at the same position as a wall -
not only is this something that would ostensibly never happen, it's also
completely reasonable to assume that someone stuck in a wall (due to a
bad teleport perhaps?) wouldn't be able to see anything, on account of
their head being INSIDE A WALL.
-rw-r--r--src/Xanthous/Data/EntityMap/Graphics.hs3
-rw-r--r--test/Xanthous/Data/EntityMap/GraphicsSpec.hs1
2 files changed, 2 insertions, 2 deletions
diff --git a/src/Xanthous/Data/EntityMap/Graphics.hs b/src/Xanthous/Data/EntityMap/Graphics.hs
index d523c0555e4f..0f2f2bfe16d6 100644
--- a/src/Xanthous/Data/EntityMap/Graphics.hs
+++ b/src/Xanthous/Data/EntityMap/Graphics.hs
@@ -56,8 +56,7 @@ linesOfSight (view _Position -> pos) visionRadius em
 visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e
 visibleEntities pos visionRadius
   = fromEIDsAndPositioned
-  . fold
-  . map (\(p, es) -> over _2 (Positioned p) <$> es)
+  . foldMap (\(p, es) -> over _2 (Positioned p) <$> es)
   . fold
   . linesOfSight pos visionRadius
 
diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
index 55ae0d79dbb8..fd37548ce864 100644
--- a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
+++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
@@ -19,6 +19,7 @@ test = testGroup "Xanthous.Data.EntityMap.Graphics"
   [ testGroup "visiblePositions"
     [ testProperty "one step in each cardinal direction is always visible"
       $ \pos (Cardinal dir) (Positive r) (wallPositions :: Set Position)->
+          pos `notMember` wallPositions ==>
           let em = review _EntityMap . map (, Wall) . toList $ wallPositions
               em' = em & atPosition (move dir pos) %~ (Wall <|)
               poss = visiblePositions pos r em'