Add entities, and allow walking around

Add support for entities via a port of the EntityMap type, and implement
command support starting at basic hjkl.
This commit is contained in:
Griffin Smith 2019-08-31 13:17:27 -04:00
parent 6eba471e24
commit 4ef19aa35a
21 changed files with 719 additions and 32 deletions

30
test/Xanthous/GameSpec.hs Normal file
View file

@ -0,0 +1,30 @@
module Xanthous.GameSpec where
import Test.Prelude hiding (Down)
import Xanthous.Game
import Control.Lens.Properties
import Xanthous.Data (move, Direction(Down))
import Xanthous.Data.EntityMap (atPosition)
import Xanthous.Entities.SomeEntity
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Game"
[ testGroup "positionedCharacter"
[ testProperty "lens laws" $ isLens positionedCharacter
, testCase "updates the position of the character" $ do
let initialGame = getInitialState
initialPos = initialGame ^. characterPosition
updatedGame = initialGame & characterPosition %~ move Down
updatedPos = updatedGame ^. characterPosition
updatedPos @?= move Down initialPos
updatedGame ^. entities . atPosition initialPos @?= fromList []
updatedGame ^. entities . atPosition updatedPos
@?= fromList [SomeEntity $ initialGame ^. character]
]
, testGroup "characterPosition"
[ testProperty "lens laws" $ isLens characterPosition
]
]