about summary refs log tree commit diff
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
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.
-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