about summary refs log tree commit diff
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/Spec.hs2
-rw-r--r--test/Xanthous/Data/EntityMap/GraphicsSpec.hs47
2 files changed, 49 insertions, 0 deletions
diff --git a/test/Spec.hs b/test/Spec.hs
index cd2827e58b4e..73b965bdb6ca 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,6 +1,7 @@
 import Test.Prelude
 import qualified Xanthous.Data.EntityCharSpec
 import qualified Xanthous.Data.EntityMapSpec
+import qualified Xanthous.Data.EntityMap.GraphicsSpec
 import qualified Xanthous.DataSpec
 import qualified Xanthous.Entities.RawsSpec
 import qualified Xanthous.GameSpec
@@ -18,6 +19,7 @@ test :: TestTree
 test = testGroup "Xanthous"
   [ Xanthous.Data.EntityCharSpec.test
   , Xanthous.Data.EntityMapSpec.test
+  , Xanthous.Data.EntityMap.GraphicsSpec.test
   , Xanthous.Entities.RawsSpec.test
   , Xanthous.GameSpec.test
   , Xanthous.Generators.UtilSpec.test
diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
new file mode 100644
index 000000000000..6b736be4ee21
--- /dev/null
+++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
@@ -0,0 +1,47 @@
+--------------------------------------------------------------------------------
+module Xanthous.Data.EntityMap.GraphicsSpec (main, test) where
+--------------------------------------------------------------------------------
+import Test.Prelude
+import Data.Aeson
+--------------------------------------------------------------------------------
+import Xanthous.Game.State
+import Xanthous.Data
+import Xanthous.Data.EntityMap
+import Xanthous.Data.EntityMap.Graphics
+--------------------------------------------------------------------------------
+
+main :: IO ()
+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
+          <> ")"
+          )
+    ]
+  ]
+
+--------------------------------------------------------------------------------
+
+data TestEntity = TestEntity
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (ToJSON, FromJSON, NFData)
+
+instance Brain TestEntity where
+  step _ = pure
+instance Draw TestEntity
+instance Entity TestEntity where
+  blocksVision _ = False
+  description _ = ""
+  entityChar _ = "e"