2 files changed, 56 insertions, 34 deletions
diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
index 9347a1c1b569..55ae0d79dbb8 100644
--- a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
+++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
@@ -8,6 +8,7 @@ import Xanthous.Game.State
 import Xanthous.Data
 import Xanthous.Data.EntityMap
 import Xanthous.Data.EntityMap.Graphics
+import Xanthous.Entities.Environment (Wall(..))
 --------------------------------------------------------------------------------
 
 main :: IO ()
@@ -16,19 +17,28 @@ main = defaultMain test
 test :: TestTree
 test = testGroup "Xanthous.Data.EntityMap.Graphics"
   [ testGroup "visiblePositions"
-    [ testCase "non-contiguous bug 1" $
-        let charPos = Position 20 20
-            gormlakPos = Position 17 19
-            em = insertAt gormlakPos TestEntity
-               . insertAt charPos TestEntity
-               $ mempty
-            visPositions = visiblePositions charPos 12 em
-        in (gormlakPos `member` visPositions) @?
-          ( "not ("
-          <> show gormlakPos <> " `member` "
-          <> show visPositions
-          <> ")"
-          )
+    [ testProperty "one step in each cardinal direction is always visible"
+      $ \pos (Cardinal dir) (Positive r) (wallPositions :: Set Position)->
+          let em = review _EntityMap . map (, Wall) . toList $ wallPositions
+              em' = em & atPosition (move dir pos) %~ (Wall <|)
+              poss = visiblePositions pos r em'
+          in counterexample ("visiblePositions: " <> show poss)
+             $ move dir pos `member` poss
+    , testGroup "bugs"
+      [ testCase "non-contiguous bug 1"
+        $ let charPos = Position 20 20
+              gormlakPos = Position 17 19
+              em = insertAt gormlakPos TestEntity
+                   . insertAt charPos TestEntity
+                   $ mempty
+              visPositions = visiblePositions charPos 12 em
+          in (gormlakPos `member` visPositions) @?
+             ( "not ("
+             <> show gormlakPos <> " `member` "
+             <> show visPositions
+             <> ")"
+             )
+      ]
     ]
   ]
 
diff --git a/test/Xanthous/Util/GraphicsSpec.hs b/test/Xanthous/Util/GraphicsSpec.hs
index ecd6dbe19197..a1eaf73e2845 100644
--- a/test/Xanthous/Util/GraphicsSpec.hs
+++ b/test/Xanthous/Util/GraphicsSpec.hs
@@ -13,30 +13,40 @@ main = defaultMain test
 test :: TestTree
 test = testGroup "Xanthous.Util.Graphics"
   [ testGroup "circle"
-    [ testCase "radius 12, origin 0"
+    [ testCase "radius 1, origin 2,2"
+      {-
+        |   | 0 | 1 | 2 | 3 |
+        |---+---+---+---+---|
+        | 0 |   |   |   |   |
+        | 1 |   |   | x |   |
+        | 2 |   | x |   | x |
+        | 3 |   |   | x |   |
+      -}
+      $ (sort . unique @[] @[_]) (circle @Int (2, 2) 1)
+      @?= [ (1, 2)
+          , (2, 1), (2, 3)
+          , (3, 2)
+          ]
+    , testCase "radius 12, origin 0"
       $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12)
-      @?= [ (1,12)
-          , (2,12)
-          , (3,12)
-          , (4,12)
-          , (5,12)
-          , (6,11)
-          , (7,10)
-          , (7,11)
-          , (8,10)
-          , (9,9)
-          , (10,7)
-          , (10,8)
-          , (11,6)
-          , (11,7)
-          , (12,1)
-          , (12,2)
-          , (12,3)
-          , (12,4)
-          , (12,5)
+      @?= [ (-12,-4),(-12,-3),(-12,-2),(-12,-1),(-12,0),(-12,1),(-12,2)
+          , (-12,3),(-12,4),(-11,-6),(-11,-5),(-11,5),(-11,6),(-10,-7),(-10,7)
+          , (-9,-9),(-9,-8),(-9,8),(-9,9),(-8,-9),(-8,9),(-7,-10),(-7,10)
+          , (-6,-11),(-6,11),(-5,-11),(-5 ,11),(-4,-12),(-4,12),(-3,-12),(-3,12)
+          , (-2,-12),(-2,12),(-1,-12),(-1,12),(0,-12),(0,12),(1,-12),(1,12)
+          , (2,-12),(2,12),(3,-12),(3,12),(4,-12),(4,12),(5,-11),(5 ,11),(6,-11)
+          , (6,11),(7,-10),(7,10),(8,-9),(8,9),(9,-9),(9,-8),(9,8),(9,9),(10,-7)
+          , (10,7),(11,-6),(11,-5),(11,5),(11,6),(12,-4),(12,-3),(12,-2),(12,-1)
+          , (12,0), (12,1),(12,2),(12,3),(12,4)
           ]
-    ]
 
+    -- , testProperty "is a subset of filledCircle" $ \center radius ->
+    --     let circ = circle @Int center radius
+    --         filledCirc = filledCircle center radius
+    --     in counterexample ( "circle: " <> show circ
+    --                        <> "\nfilledCircle: " <> show filledCirc)
+    --       $ setFromList circ `isSubsetOf` setFromList filledCirc
+    ]
   , testGroup "line"
     [ testProperty "starts and ends at the start and end points" $ \start end ->
         let ℓ = line @Int start end
@@ -44,3 +54,5 @@ test = testGroup "Xanthous.Util.Graphics"
         $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end)
     ]
   ]
+
+--------------------------------------------------------------------------------