about summary refs log tree commit diff
path: root/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
diff options
context:
space:
mode:
authorGriffin Smith <root@gws.fyi>2019-12-23T22·55-0500
committerGriffin Smith <root@gws.fyi>2019-12-23T22·55-0500
commit32421916e09dc56d91707af10474644276712fc5 (patch)
treed48ae5b6bf5239ddffe13f0fa3c2c34448839a78 /test/Xanthous/Data/EntityMap/GraphicsSpec.hs
parenta58966d43f86d6fae92c1fc11e43650177fcecd1 (diff)
Update the vision every time we step the game
Recalculate the character's lines of sight every time we step the game,
rather than just every time the character *moves*. I had originally
thought this was a non-contiguous lines-of-sight bug - which there's a
test disproving - but it actually turned out to be that actions like
eating or attacking would step the game forward (thus moving gormlaks)
without re-calculating the positions visible to the character.
Diffstat (limited to 'test/Xanthous/Data/EntityMap/GraphicsSpec.hs')
-rw-r--r--test/Xanthous/Data/EntityMap/GraphicsSpec.hs47
1 files changed, 47 insertions, 0 deletions
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"