Add staircases, and moving between levels
Currently we just pick randomly between the cave and dungeon level generators. There's a lot of bugs here, but it's *sorta* working, so I'm leaving it as is.
This commit is contained in:
		
							parent
							
								
									6b0bab0e85
								
							
						
					
					
						commit
						0f79a06733
					
				
					 12 changed files with 125 additions and 17 deletions
				
			
		|  | @ -14,6 +14,7 @@ import           Control.Monad.Random (MonadRandom) | ||||||
| import           Control.Monad.State.Class (modify) | import           Control.Monad.State.Class (modify) | ||||||
| import           Data.Aeson (object, ToJSON) | import           Data.Aeson (object, ToJSON) | ||||||
| import qualified Data.Aeson as A | import qualified Data.Aeson as A | ||||||
|  | import           Data.List.NonEmpty (NonEmpty(..)) | ||||||
| import qualified Data.Vector as V | import qualified Data.Vector as V | ||||||
| import           System.Exit | import           System.Exit | ||||||
| import           System.Directory (doesFileExist) | import           System.Directory (doesFileExist) | ||||||
|  | @ -30,6 +31,8 @@ import           Xanthous.Data | ||||||
|                  ) |                  ) | ||||||
| import           Xanthous.Data.EntityMap (EntityMap) | import           Xanthous.Data.EntityMap (EntityMap) | ||||||
| import qualified Xanthous.Data.EntityMap as EntityMap | import qualified Xanthous.Data.EntityMap as EntityMap | ||||||
|  | import           Xanthous.Data.Levels (prevLevel, nextLevel) | ||||||
|  | import qualified Xanthous.Data.Levels as Levels | ||||||
| import           Xanthous.Game | import           Xanthous.Game | ||||||
| import           Xanthous.Game.State | import           Xanthous.Game.State | ||||||
| import           Xanthous.Game.Draw (drawGame) | import           Xanthous.Game.Draw (drawGame) | ||||||
|  | @ -37,6 +40,7 @@ import           Xanthous.Game.Prompt | ||||||
| import           Xanthous.Monad | import           Xanthous.Monad | ||||||
| import           Xanthous.Resource (Name, Panel(..)) | import           Xanthous.Resource (Name, Panel(..)) | ||||||
| import qualified Xanthous.Messages as Messages | import qualified Xanthous.Messages as Messages | ||||||
|  | import           Xanthous.Random | ||||||
| import           Xanthous.Util (removeVectorIndex) | import           Xanthous.Util (removeVectorIndex) | ||||||
| import           Xanthous.Util.Inflection (toSentence) | import           Xanthous.Util.Inflection (toSentence) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
|  | @ -47,13 +51,14 @@ import qualified Xanthous.Entities.Item as Item | ||||||
| import           Xanthous.Entities.Creature (Creature) | import           Xanthous.Entities.Creature (Creature) | ||||||
| import qualified Xanthous.Entities.Creature as Creature | import qualified Xanthous.Entities.Creature as Creature | ||||||
| import           Xanthous.Entities.Environment | import           Xanthous.Entities.Environment | ||||||
|                  (Door, open, locked, GroundMessage(..)) |                  (Door, open, locked, GroundMessage(..), Staircase(..)) | ||||||
| import           Xanthous.Entities.RawTypes | import           Xanthous.Entities.RawTypes | ||||||
|                  ( edible, eatMessage, hitpointsHealed |                  ( edible, eatMessage, hitpointsHealed | ||||||
|                  , attackMessage |                  , attackMessage | ||||||
|                  ) |                  ) | ||||||
| import           Xanthous.Generators | import           Xanthous.Generators | ||||||
| import qualified Xanthous.Generators.CaveAutomata as CaveAutomata | import qualified Xanthous.Generators.CaveAutomata as CaveAutomata | ||||||
|  | import qualified Xanthous.Generators.Dungeon as Dungeon | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| type App = Brick.App GameState () Name | type App = Brick.App GameState () Name | ||||||
|  | @ -87,10 +92,7 @@ startEvent = do | ||||||
| 
 | 
 | ||||||
| initLevel :: AppM () | initLevel :: AppM () | ||||||
| initLevel = do | initLevel = do | ||||||
|   level <- |   level <- genLevel 0 | ||||||
|     generateLevel SCaveAutomata CaveAutomata.defaultParams |  | ||||||
|     $ Dimensions 80 80 |  | ||||||
| 
 |  | ||||||
|   entities <>= levelToEntityMap level |   entities <>= levelToEntityMap level | ||||||
|   characterPosition .= level ^. levelCharacterPosition |   characterPosition .= level ^. levelCharacterPosition | ||||||
| 
 | 
 | ||||||
|  | @ -273,6 +275,40 @@ handleCommand Save = do | ||||||
|         writeFile (unpack filename) $ toStrict src |         writeFile (unpack filename) $ toStrict src | ||||||
|         exitSuccess |         exitSuccess | ||||||
| 
 | 
 | ||||||
|  | handleCommand GoUp = do | ||||||
|  |   charPos <- use characterPosition | ||||||
|  |   hasStairs <- uses (entities . EntityMap.atPosition charPos) | ||||||
|  |               $ elem (SomeEntity UpStaircase) | ||||||
|  |   if hasStairs | ||||||
|  |   then uses levels prevLevel >>= \case | ||||||
|  |     Just levs' -> levels .= levs' | ||||||
|  |     Nothing -> | ||||||
|  |       -- TODO in nethack, this leaves the game. Maybe something similar here? | ||||||
|  |       say_ ["cant", "goUp"] | ||||||
|  |   else say_ ["cant", "goUp"] | ||||||
|  | 
 | ||||||
|  |   continue | ||||||
|  | 
 | ||||||
|  | handleCommand GoDown = do | ||||||
|  |   charPos <- use characterPosition | ||||||
|  |   hasStairs <- uses (entities . EntityMap.atPosition charPos) | ||||||
|  |               $ elem (SomeEntity DownStaircase) | ||||||
|  | 
 | ||||||
|  |   if hasStairs | ||||||
|  |   then do | ||||||
|  |     levs <- use levels | ||||||
|  |     let newLevelNum = Levels.pos levs + 1 | ||||||
|  |     levs' <- nextLevel (levelToEntityMap <$> genLevel newLevelNum) levs | ||||||
|  |     cEID <- use characterEntityID | ||||||
|  |     pCharacter <- use $ entities . at cEID | ||||||
|  |     entities . at cEID .= Nothing | ||||||
|  |     levels .= levs' | ||||||
|  |     entities . at cEID .= pCharacter | ||||||
|  |   else say_ ["cant", "goDown"] | ||||||
|  | 
 | ||||||
|  |   continue | ||||||
|  | 
 | ||||||
|  | -- | ||||||
| 
 | 
 | ||||||
| handleCommand ToggleRevealAll = do | handleCommand ToggleRevealAll = do | ||||||
|   val <- debugState . allRevealed <%= not |   val <- debugState . allRevealed <%= not | ||||||
|  | @ -551,3 +587,17 @@ showPanel panel = do | ||||||
|   prompt_ @'Continue ["generic", "continue"] Uncancellable |   prompt_ @'Continue ["generic", "continue"] Uncancellable | ||||||
|     . const |     . const | ||||||
|     $ activePanel .= Nothing |     $ activePanel .= Nothing | ||||||
|  | 
 | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | genLevel | ||||||
|  |   :: Int -- ^ level number | ||||||
|  |   -> AppM Level | ||||||
|  | genLevel _num = do | ||||||
|  |   let dims = Dimensions 80 80 | ||||||
|  |   generator <- choose $ CaveAutomata :| [Dungeon] | ||||||
|  |   level <- case generator of | ||||||
|  |     CaveAutomata -> generateLevel SCaveAutomata CaveAutomata.defaultParams dims | ||||||
|  |     Dungeon -> generateLevel SDungeon Dungeon.defaultParams dims | ||||||
|  |   characterPosition .= level ^. levelCharacterPosition | ||||||
|  |   pure $!! level | ||||||
|  |  | ||||||
|  | @ -23,6 +23,8 @@ data Command | ||||||
|   | Read |   | Read | ||||||
|   | ShowInventory |   | ShowInventory | ||||||
|   | Wield |   | Wield | ||||||
|  |   | GoUp | ||||||
|  |   | GoDown | ||||||
| 
 | 
 | ||||||
|     -- | TODO replace with `:` commands |     -- | TODO replace with `:` commands | ||||||
|   | ToggleRevealAll |   | ToggleRevealAll | ||||||
|  | @ -41,6 +43,8 @@ commandFromKey (KChar 'S') [] = Just Save | ||||||
| commandFromKey (KChar 'r') [] = Just Read | commandFromKey (KChar 'r') [] = Just Read | ||||||
| commandFromKey (KChar 'i') [] = Just ShowInventory | commandFromKey (KChar 'i') [] = Just ShowInventory | ||||||
| commandFromKey (KChar 'w') [] = Just Wield | commandFromKey (KChar 'w') [] = Just Wield | ||||||
|  | commandFromKey (KChar '<') [] = Just GoUp | ||||||
|  | commandFromKey (KChar '>') [] = Just GoDown | ||||||
| 
 | 
 | ||||||
| -- DEBUG COMMANDS -- | -- DEBUG COMMANDS -- | ||||||
| commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll | commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll | ||||||
|  |  | ||||||
|  | @ -14,7 +14,7 @@ module Xanthous.Data.Levels | ||||||
|   , ComonadStore(..) |   , ComonadStore(..) | ||||||
|   ) where |   ) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Prelude hiding ((<.>), Empty, foldMap, levels) | import           Xanthous.Prelude hiding ((<.>), Empty, foldMap) | ||||||
| import           Xanthous.Util (between, EqProp, EqEqProp(..)) | import           Xanthous.Util (between, EqProp, EqEqProp(..)) | ||||||
| import           Xanthous.Util.Comonad (current) | import           Xanthous.Util.Comonad (current) | ||||||
| import           Xanthous.Orphans () | import           Xanthous.Orphans () | ||||||
|  |  | ||||||
|  | @ -3,13 +3,18 @@ module Xanthous.Entities.Environment | ||||||
|   ( |   ( | ||||||
|     -- * Walls |     -- * Walls | ||||||
|     Wall(..) |     Wall(..) | ||||||
|  | 
 | ||||||
|     -- * Doors |     -- * Doors | ||||||
|   , Door(..) |   , Door(..) | ||||||
|   , open |   , open | ||||||
|   , locked |   , locked | ||||||
|   , unlockedDoor |   , unlockedDoor | ||||||
|  | 
 | ||||||
|     -- * Messages |     -- * Messages | ||||||
|   , GroundMessage(..) |   , GroundMessage(..) | ||||||
|  | 
 | ||||||
|  |     -- * Stairs | ||||||
|  |   , Staircase(..) | ||||||
|   ) where |   ) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import Xanthous.Prelude | import Xanthous.Prelude | ||||||
|  | @ -122,3 +127,28 @@ instance Entity GroundMessage where | ||||||
|   description = const "a message on the ground. Press r. to read it." |   description = const "a message on the ground. Press r. to read it." | ||||||
|   entityChar = const "≈" |   entityChar = const "≈" | ||||||
|   entityCollision = const Nothing |   entityCollision = const Nothing | ||||||
|  | 
 | ||||||
|  | -------------------------------------------------------------------------------- | ||||||
|  | 
 | ||||||
|  | data Staircase = UpStaircase | DownStaircase | ||||||
|  |   deriving stock (Show, Eq, Ord, Generic) | ||||||
|  |   deriving anyclass (NFData, CoArbitrary, Function) | ||||||
|  |   deriving Arbitrary via GenericArbitrary Staircase | ||||||
|  |   deriving (ToJSON, FromJSON) | ||||||
|  |        via WithOptions '[ 'TagSingleConstructors 'True | ||||||
|  |                         , 'SumEnc 'ObjWithSingleField | ||||||
|  |                         ] | ||||||
|  |            Staircase | ||||||
|  | instance Brain Staircase where step = brainVia Brainless | ||||||
|  | 
 | ||||||
|  | instance Draw Staircase where | ||||||
|  |   draw UpStaircase = str "<" | ||||||
|  |   draw DownStaircase = str ">" | ||||||
|  | 
 | ||||||
|  | instance Entity Staircase where | ||||||
|  |   blocksVision = const False | ||||||
|  |   description UpStaircase = "a staircase leading upwards" | ||||||
|  |   description DownStaircase = "a staircase leading downwards" | ||||||
|  |   entityChar UpStaircase = "<" | ||||||
|  |   entityChar DownStaircase = ">" | ||||||
|  |   entityCollision = const Nothing | ||||||
|  |  | ||||||
|  | @ -1,5 +1,6 @@ | ||||||
| module Xanthous.Game | module Xanthous.Game | ||||||
|   ( GameState(..) |   ( GameState(..) | ||||||
|  |   , levels | ||||||
|   , entities |   , entities | ||||||
|   , revealedPositions |   , revealedPositions | ||||||
|   , messageHistory |   , messageHistory | ||||||
|  |  | ||||||
|  | @ -5,7 +5,7 @@ | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| module Xanthous.Game.Arbitrary where | module Xanthous.Game.Arbitrary where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Prelude hiding (levels, foldMap) | import           Xanthous.Prelude hiding (foldMap) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Test.QuickCheck | import           Test.QuickCheck | ||||||
| import           System.Random | import           System.Random | ||||||
|  | @ -23,13 +23,13 @@ instance Arbitrary GameState where | ||||||
|     chr <- arbitrary @Character |     chr <- arbitrary @Character | ||||||
|     charPos <- arbitrary |     charPos <- arbitrary | ||||||
|     _messageHistory <- arbitrary |     _messageHistory <- arbitrary | ||||||
|     levels <- arbitrary |     levs <- arbitrary | ||||||
|     let (_characterEntityID, currentLevel) = |     let (_characterEntityID, currentLevel) = | ||||||
|           EntityMap.insertAtReturningID charPos (SomeEntity chr) |           EntityMap.insertAtReturningID charPos (SomeEntity chr) | ||||||
|           $ extract levels |           $ extract levs | ||||||
|         _levels = levels & current .~ currentLevel |         _levels = levs & current .~ currentLevel | ||||||
|     _revealedPositions <- fmap setFromList . sublistOf |     _revealedPositions <- fmap setFromList . sublistOf | ||||||
|                          $ foldMap EntityMap.positions levels |                          $ foldMap EntityMap.positions levs | ||||||
|     _randomGen <- mkStdGen <$> arbitrary |     _randomGen <- mkStdGen <$> arbitrary | ||||||
|     let _promptState = NoPrompt -- TODO |     let _promptState = NoPrompt -- TODO | ||||||
|     _activePanel <- arbitrary |     _activePanel <- arbitrary | ||||||
|  |  | ||||||
|  | @ -7,6 +7,7 @@ | ||||||
| module Xanthous.Game.State | module Xanthous.Game.State | ||||||
|   ( GameState(..) |   ( GameState(..) | ||||||
|   , entities |   , entities | ||||||
|  |   , levels | ||||||
|   , revealedPositions |   , revealedPositions | ||||||
|   , messageHistory |   , messageHistory | ||||||
|   , randomGen |   , randomGen | ||||||
|  | @ -58,7 +59,7 @@ module Xanthous.Game.State | ||||||
|   , allRevealed |   , allRevealed | ||||||
|   ) where |   ) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Prelude hiding (levels) | import           Xanthous.Prelude | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Data.List.NonEmpty ( NonEmpty((:|))) | import           Data.List.NonEmpty ( NonEmpty((:|))) | ||||||
| import qualified Data.List.NonEmpty as NonEmpty | import qualified Data.List.NonEmpty as NonEmpty | ||||||
|  |  | ||||||
|  | @ -4,6 +4,7 @@ | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| module Xanthous.Generators | module Xanthous.Generators | ||||||
|   ( generate |   ( generate | ||||||
|  |   , Generator(..) | ||||||
|   , SGenerator(..) |   , SGenerator(..) | ||||||
|   , GeneratorInput |   , GeneratorInput | ||||||
|   , generateFromInput |   , generateFromInput | ||||||
|  | @ -20,7 +21,7 @@ module Xanthous.Generators | ||||||
|   , levelToEntityMap |   , levelToEntityMap | ||||||
|   ) where |   ) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import           Xanthous.Prelude hiding (Level) | import           Xanthous.Prelude | ||||||
| import           Data.Array.Unboxed | import           Data.Array.Unboxed | ||||||
| import           System.Random (RandomGen) | import           System.Random (RandomGen) | ||||||
| import qualified Options.Applicative as Opt | import qualified Options.Applicative as Opt | ||||||
|  | @ -31,7 +32,7 @@ import qualified Xanthous.Generators.Dungeon as Dungeon | ||||||
| import           Xanthous.Generators.Util | import           Xanthous.Generators.Util | ||||||
| import           Xanthous.Generators.LevelContents | import           Xanthous.Generators.LevelContents | ||||||
| import           Xanthous.Data (Dimensions, Position'(Position), Position) | import           Xanthous.Data (Dimensions, Position'(Position), Position) | ||||||
| import           Xanthous.Data.EntityMap (EntityMap) | import           Xanthous.Data.EntityMap (EntityMap, _EntityMap) | ||||||
| import qualified Xanthous.Data.EntityMap as EntityMap | import qualified Xanthous.Data.EntityMap as EntityMap | ||||||
| import           Xanthous.Entities.Environment | import           Xanthous.Entities.Environment | ||||||
| import           Xanthous.Entities.Item (Item) | import           Xanthous.Entities.Item (Item) | ||||||
|  | @ -116,8 +117,11 @@ data Level = Level | ||||||
|   , _levelItems             :: !(EntityMap Item) |   , _levelItems             :: !(EntityMap Item) | ||||||
|   , _levelCreatures         :: !(EntityMap Creature) |   , _levelCreatures         :: !(EntityMap Creature) | ||||||
|   , _levelTutorialMessage   :: !(EntityMap GroundMessage) |   , _levelTutorialMessage   :: !(EntityMap GroundMessage) | ||||||
|  |   , _levelStaircases        :: !(EntityMap Staircase) | ||||||
|   , _levelCharacterPosition :: !Position |   , _levelCharacterPosition :: !Position | ||||||
|   } |   } | ||||||
|  |   deriving stock (Generic) | ||||||
|  |   deriving anyclass (NFData) | ||||||
| makeLenses ''Level | makeLenses ''Level | ||||||
| 
 | 
 | ||||||
| generateLevel | generateLevel | ||||||
|  | @ -134,6 +138,9 @@ generateLevel gen ps dims = do | ||||||
|   _levelCreatures <- randomCreatures cells |   _levelCreatures <- randomCreatures cells | ||||||
|   _levelDoors <- randomDoors cells |   _levelDoors <- randomDoors cells | ||||||
|   _levelCharacterPosition <- chooseCharacterPosition cells |   _levelCharacterPosition <- chooseCharacterPosition cells | ||||||
|  |   let upStaircase = _EntityMap # [(_levelCharacterPosition, UpStaircase)] | ||||||
|  |   downStaircase <- placeDownStaircase cells | ||||||
|  |   let _levelStaircases = upStaircase <> downStaircase | ||||||
|   _levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition |   _levelTutorialMessage <- tutorialMessage cells _levelCharacterPosition | ||||||
|   pure Level {..} |   pure Level {..} | ||||||
| 
 | 
 | ||||||
|  | @ -144,3 +151,4 @@ levelToEntityMap level | ||||||
|   <> (SomeEntity <$> level ^. levelItems) |   <> (SomeEntity <$> level ^. levelItems) | ||||||
|   <> (SomeEntity <$> level ^. levelCreatures) |   <> (SomeEntity <$> level ^. levelCreatures) | ||||||
|   <> (SomeEntity <$> level ^. levelTutorialMessage) |   <> (SomeEntity <$> level ^. levelTutorialMessage) | ||||||
|  |   <> (SomeEntity <$> level ^. levelStaircases) | ||||||
|  |  | ||||||
|  | @ -4,6 +4,7 @@ module Xanthous.Generators.LevelContents | ||||||
|   , randomItems |   , randomItems | ||||||
|   , randomCreatures |   , randomCreatures | ||||||
|   , randomDoors |   , randomDoors | ||||||
|  |   , placeDownStaircase | ||||||
|   , tutorialMessage |   , tutorialMessage | ||||||
|   ) where |   ) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
|  | @ -23,7 +24,7 @@ import           Xanthous.Entities.Item (Item) | ||||||
| import qualified Xanthous.Entities.Creature as Creature | import qualified Xanthous.Entities.Creature as Creature | ||||||
| import           Xanthous.Entities.Creature (Creature) | import           Xanthous.Entities.Creature (Creature) | ||||||
| import           Xanthous.Entities.Environment | import           Xanthous.Entities.Environment | ||||||
|                  (GroundMessage(..), Door(..), unlockedDoor) |                  (GroundMessage(..), Door(..), unlockedDoor, Staircase(..)) | ||||||
| import           Xanthous.Messages (message_) | import           Xanthous.Messages (message_) | ||||||
| import           Xanthous.Util.Graphics (circle) | import           Xanthous.Util.Graphics (circle) | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
|  | @ -34,6 +35,11 @@ chooseCharacterPosition = randomPosition | ||||||
| randomItems :: MonadRandom m => Cells -> m (EntityMap Item) | randomItems :: MonadRandom m => Cells -> m (EntityMap Item) | ||||||
| randomItems = randomEntities Item.newWithType (0.0004, 0.001) | randomItems = randomEntities Item.newWithType (0.0004, 0.001) | ||||||
| 
 | 
 | ||||||
|  | placeDownStaircase :: MonadRandom m => Cells -> m (EntityMap Staircase) | ||||||
|  | placeDownStaircase cells = do | ||||||
|  |   pos <- randomPosition cells | ||||||
|  |   pure $ _EntityMap # [(pos, DownStaircase)] | ||||||
|  | 
 | ||||||
| randomDoors :: MonadRandom m => Cells -> m (EntityMap Door) | randomDoors :: MonadRandom m => Cells -> m (EntityMap Door) | ||||||
| randomDoors cells = do | randomDoors cells = do | ||||||
|   doorRatio <- getRandomR subsetRange |   doorRatio <- getRandomR subsetRange | ||||||
|  |  | ||||||
|  | @ -19,7 +19,7 @@ import ClassyPrelude hiding | ||||||
|   (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say) |   (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say) | ||||||
| import Data.Kind | import Data.Kind | ||||||
| import GHC.TypeLits hiding (Text) | import GHC.TypeLits hiding (Text) | ||||||
| import Control.Lens | import Control.Lens hiding (levels, Level) | ||||||
| import Data.Void | import Data.Void | ||||||
| import Control.Comonad | import Control.Comonad | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
|  |  | ||||||
|  | @ -23,6 +23,14 @@ pickUp: | ||||||
|   pickUp: You pick up the {{item.itemType.name}} |   pickUp: You pick up the {{item.itemType.name}} | ||||||
|   nothingToPickUp: "There's nothing here to pick up" |   nothingToPickUp: "There's nothing here to pick up" | ||||||
| 
 | 
 | ||||||
|  | cant: | ||||||
|  |   goUp: | ||||||
|  |     - You can't go up here | ||||||
|  |     - There's nothing here that would let you go up | ||||||
|  |   goDown: | ||||||
|  |     - You can't go down here | ||||||
|  |     - There's nothing here that would let you go down | ||||||
|  | 
 | ||||||
| open: | open: | ||||||
|   prompt: Direction to open (hjklybnu.)? |   prompt: Direction to open (hjklybnu.)? | ||||||
|   success: "You open the door." |   success: "You open the door." | ||||||
|  |  | ||||||
|  | @ -1,7 +1,7 @@ | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| module Xanthous.Data.LevelsSpec (main, test) where | module Xanthous.Data.LevelsSpec (main, test) where | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import Test.Prelude hiding (levels) | import Test.Prelude | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
| import qualified Data.Aeson as JSON | import qualified Data.Aeson as JSON | ||||||
| -------------------------------------------------------------------------------- | -------------------------------------------------------------------------------- | ||||||
|  |  | ||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue