diff options
| -rw-r--r-- | src/Xanthous/App.hs | 3 | ||||
| -rw-r--r-- | test/Spec.hs | 2 | ||||
| -rw-r--r-- | test/Xanthous/Data/EntityMap/GraphicsSpec.hs | 47 | ||||
| -rw-r--r-- | xanthous.cabal | 3 |
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 |