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.

1 files changed, 30 insertions, 0 deletions

diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs
index dee8d83c3239..993714c844c5 100644
--- a/src/Xanthous/Entities/Environment.hs
+++ b/src/Xanthous/Entities/Environment.hs
@@ -3,13 +3,18 @@ module Xanthous.Entities.Environment
   (
     -- * Walls
     Wall(..)
+
     -- * Doors
   , Door(..)
   , open
   , locked
   , unlockedDoor
+
     -- * Messages
   , GroundMessage(..)
+
+    -- * Stairs
+  , Staircase(..)
   ) where
 --------------------------------------------------------------------------------
 import Xanthous.Prelude
@@ -122,3 +127,28 @@ instance Entity GroundMessage where
   description = const "a message on the ground. Press r. to read it."
   entityChar = const "≈"
   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