Add support for multiple levels

Add a data structure, based on the zipper comonad, which provides
support for multiple levels, each of which is its own entity map. The
current level is provided by coreturn, which the `entities` lens has
been updated to use. Nothing currently supports going up or down levels
yet - that's coming next.
This commit is contained in:
Griffin Smith 2020-01-04 23:48:51 -05:00
parent e669b54f0c
commit 6b0bab0e85
11 changed files with 397 additions and 14 deletions

View file

@ -5,15 +5,17 @@
--------------------------------------------------------------------------------
module Xanthous.Game.Arbitrary where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Xanthous.Prelude hiding (levels, foldMap)
--------------------------------------------------------------------------------
import Test.QuickCheck
import System.Random
import Data.Foldable (foldMap)
--------------------------------------------------------------------------------
import Xanthous.Game.State
import Xanthous.Data.Levels
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Entities.Entities ()
import Xanthous.Entities.Character
import qualified Xanthous.Data.EntityMap as EntityMap
import Xanthous.Game.State
--------------------------------------------------------------------------------
instance Arbitrary GameState where
@ -21,9 +23,13 @@ instance Arbitrary GameState where
chr <- arbitrary @Character
charPos <- arbitrary
_messageHistory <- arbitrary
(_characterEntityID, _entities) <- arbitrary <&>
EntityMap.insertAtReturningID charPos (SomeEntity chr)
_revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities
levels <- arbitrary
let (_characterEntityID, currentLevel) =
EntityMap.insertAtReturningID charPos (SomeEntity chr)
$ extract levels
_levels = levels & current .~ currentLevel
_revealedPositions <- fmap setFromList . sublistOf
$ foldMap EntityMap.positions levels
_randomGen <- mkStdGen <$> arbitrary
let _promptState = NoPrompt -- TODO
_activePanel <- arbitrary