about summary refs log tree commit diff
path: root/test/Xanthous
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-09-15T17·00-0400
committerGriffin Smith <root@gws.fyi>2019-09-15T21·30-0400
commit58fce2ec1976b957c7e24a282964c62f7ddf7b02 (patch)
treed7746cd93bcdda4faac465574ae66ea6b481d106 /test/Xanthous
parent6678ac986c0ccdc2a809da4fc99de7bcc0eb21f4 (diff)
Progressively reveal the map to the player
As the character walks around the map, progressively reveal the entities
on the map to them, using an algorithm based on well known
circle-rasterizing and line-rasterizing algorithms to calculate lines of
sight that are potentially obscured by walls.
Diffstat (limited to 'test/Xanthous')
-rw-r--r--test/Xanthous/Data/EntityMapSpec.hs6
-rw-r--r--test/Xanthous/Util/GraphicsSpec.hs39
2 files changed, 44 insertions, 1 deletions
diff --git a/test/Xanthous/Data/EntityMapSpec.hs b/test/Xanthous/Data/EntityMapSpec.hs
index c08b568d9eca..00bf1500466a 100644
--- a/test/Xanthous/Data/EntityMapSpec.hs
+++ b/test/Xanthous/Data/EntityMapSpec.hs
@@ -11,8 +11,12 @@ main :: IO ()
 main = defaultMain test
 
 test :: TestTree
-test = testGroup "Xanthous.Data.EntityMap"
+test = localOption (QuickCheckTests 20)
+  $ testGroup "Xanthous.Data.EntityMap"
   [ testBatch $ monoid @(EntityMap Int) mempty
+  , testGroup "Deduplicate"
+    [ testBatch $ monoid @(Deduplicate Int) mempty
+    ]
   , testGroup "Eq laws"
     [ testProperty "reflexivity" $ \(em :: EntityMap Int) ->
         em == em
diff --git a/test/Xanthous/Util/GraphicsSpec.hs b/test/Xanthous/Util/GraphicsSpec.hs
new file mode 100644
index 000000000000..4b761dc51fe9
--- /dev/null
+++ b/test/Xanthous/Util/GraphicsSpec.hs
@@ -0,0 +1,39 @@
+module Xanthous.Util.GraphicsSpec (main, test) where
+--------------------------------------------------------------------------------
+import Test.Prelude hiding (head)
+--------------------------------------------------------------------------------
+import Xanthous.Util.Graphics
+import Xanthous.Util
+import Data.List (head)
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Util.Graphics"
+  [ testGroup "circle"
+    [ testCase "radius 12, origin 0"
+      $ (sort . unique @[] @[_]) (circle @Int (0, 0) 12)
+      @?= (sort . unique) (
+        let quadrant =
+              [ (0, 12) , (1, 12) , (2, 12) , (3, 12)
+              , (4, 12) , (5, 11) , (6, 11) , (7, 10)
+              , (8, 9)  , (9, 9)  , (9, 8)  , (10, 7)
+              , (11, 6) , (11, 5) , (12, 4) , (12, 3)
+              , (12, 2) , (12, 1) , (12, 0)
+              ]
+        in  quadrant
+         <> (quadrant <&> _1 %~ negate)
+         <> (quadrant <&> _2 %~ negate)
+         <> (quadrant <&> both %~ negate)
+      )
+    ]
+
+  , testGroup "line"
+    [ testProperty "starts and ends at the start and end points" $ \start end ->
+        let ℓ = line @Int start end
+        in counterexample ("line: " <> show ℓ)
+        $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end)
+    ]
+  ]