6b0bab0e85
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.
43 lines
1.7 KiB
Haskell
43 lines
1.7 KiB
Haskell
{-# LANGUAGE UndecidableInstances #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
{-# LANGUAGE StandaloneDeriving #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
--------------------------------------------------------------------------------
|
|
module Xanthous.Game.Arbitrary where
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Prelude hiding (levels, foldMap)
|
|
--------------------------------------------------------------------------------
|
|
import Test.QuickCheck
|
|
import System.Random
|
|
import Data.Foldable (foldMap)
|
|
--------------------------------------------------------------------------------
|
|
import Xanthous.Data.Levels
|
|
import qualified Xanthous.Data.EntityMap as EntityMap
|
|
import Xanthous.Entities.Entities ()
|
|
import Xanthous.Entities.Character
|
|
import Xanthous.Game.State
|
|
--------------------------------------------------------------------------------
|
|
|
|
instance Arbitrary GameState where
|
|
arbitrary = do
|
|
chr <- arbitrary @Character
|
|
charPos <- arbitrary
|
|
_messageHistory <- arbitrary
|
|
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
|
|
_debugState <- arbitrary
|
|
_sentWelcome <- arbitrary
|
|
pure $ GameState {..}
|
|
|
|
|
|
instance CoArbitrary GameState
|
|
instance Function GameState
|
|
deriving newtype instance CoArbitrary (m (a, GameState)) => CoArbitrary (AppT m a)
|