chore(users): grfn -> aspen
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809 Autosubmit: aspen <root@gws.fyi> Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI Reviewed-by: lukegb <lukegb@tvl.fyi>
This commit is contained in:
parent
0ba476a426
commit
82ecd61f5c
478 changed files with 75 additions and 77 deletions
|
|
@ -0,0 +1,57 @@
|
|||
--------------------------------------------------------------------------------
|
||||
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
|
||||
import Xanthous.Entities.Environment (Wall(..))
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain test
|
||||
|
||||
test :: TestTree
|
||||
test = testGroup "Xanthous.Data.EntityMap.Graphics"
|
||||
[ testGroup "visiblePositions"
|
||||
[ testProperty "one step in each cardinal direction is always visible"
|
||||
$ \pos (Cardinal dir) (Positive r) (wallPositions :: Set Position)->
|
||||
pos `notMember` wallPositions ==>
|
||||
let em = review _EntityMap . map (, Wall) . toList $ wallPositions
|
||||
em' = em & atPosition (move dir pos) %~ (Wall <|)
|
||||
poss = visiblePositions pos r em'
|
||||
in counterexample ("visiblePositions: " <> show poss)
|
||||
$ move dir pos `member` poss
|
||||
, testGroup "bugs"
|
||||
[ 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
|
||||
description _ = ""
|
||||
entityChar _ = "e"
|
||||
Loading…
Add table
Add a link
Reference in a new issue