about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--src/Xanthous/App.hs3
-rw-r--r--test/Spec.hs2
-rw-r--r--test/Xanthous/Data/EntityMap/GraphicsSpec.hs47
-rw-r--r--xanthous.cabal3
4 files changed, 53 insertions, 2 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 2ffc11e8e6c7..2029be6f108f 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -102,6 +102,8 @@ stepGameBy ticks = do
     pEntity' <- step ticks pEntity
     entities . ix eid .= pEntity'
 
+  modify updateCharacterVision
+
   whenM (uses character isDead)
     . prompt_ @'Continue ["dead"] Uncancellable
     . const . lift . liftIO
@@ -137,7 +139,6 @@ handleCommand (Move dir) = do
       characterPosition .= newPos
       stepGameBy =<< uses (character . speed) (|*| 1)
       describeEntitiesAt newPos
-      modify updateCharacterVision
     Just Combat -> attackAt newPos
     Just Stop -> pure ()
   continue
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"
diff --git a/xanthous.cabal b/xanthous.cabal
index e70a7391f3c1..5f1abdbc8fa9 100644
--- a/xanthous.cabal
+++ b/xanthous.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: ae5b84ec168dd61b715e874bcb49579697873b164c43027a776dda725dfdffbf
+-- hash: 2d93180ab419496ded42f750d00a5b3f6c6994a9af86a8694bb585a1f52919d4
 
 name:           xanthous
 version:        0.1.0.0
@@ -208,6 +208,7 @@ test-suite test
   other-modules:
       Test.Prelude
       Xanthous.Data.EntityCharSpec
+      Xanthous.Data.EntityMap.GraphicsSpec
       Xanthous.Data.EntityMapSpec
       Xanthous.DataSpec
       Xanthous.Entities.RawsSpec