1 files changed, 0 insertions, 160 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/Entities/Environment.hs b/users/glittershark/xanthous/src/Xanthous/Entities/Environment.hs
deleted file mode 100644
index b45a91eabed2..000000000000
--- a/users/glittershark/xanthous/src/Xanthous/Entities/Environment.hs
+++ /dev/null
@@ -1,160 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Xanthous.Entities.Environment
-  (
-    -- * Walls
-    Wall(..)
-
-    -- * Doors
-  , Door(..)
-  , open
-  , closed
-  , locked
-  , unlockedDoor
-
-    -- * Messages
-  , GroundMessage(..)
-
-    -- * Stairs
-  , Staircase(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Test.QuickCheck
-import Brick (str)
-import Brick.Widgets.Border.Style (unicode)
-import Brick.Types (Edges(..))
-import Data.Aeson
-import Data.Aeson.Generic.DerivingVia
---------------------------------------------------------------------------------
-import Xanthous.Entities.Draw.Util
-import Xanthous.Data
-import Xanthous.Data.Entities
-import Xanthous.Game.State
-import Xanthous.Util.QuickCheck
---------------------------------------------------------------------------------
-
-data Wall = Wall
-  deriving stock (Show, Eq, Ord, Generic, Enum)
-  deriving anyclass (NFData, CoArbitrary, Function)
-
-instance ToJSON Wall where
-  toJSON = const $ String "Wall"
-
-instance FromJSON Wall where
-  parseJSON = withText "Wall" $ \case
-    "Wall" -> pure Wall
-    _      -> fail "Invalid Wall: expected Wall"
-
-instance Brain Wall where step = brainVia Brainless
-
-instance Entity Wall where
-  entityAttributes _ = defaultEntityAttributes
-    & blocksVision .~ True
-    & blocksObject .~ True
-  description _ = "a wall"
-  entityChar _ = "┼"
-
-instance Arbitrary Wall where
-  arbitrary = pure Wall
-
-wallEdges :: (MonoFoldable mono, Element mono ~ SomeEntity)
-          => Neighbors mono -> Edges Bool
-wallEdges neighs = any (entityIs @Wall) <$> edges neighs
-
-instance Draw Wall where
-  drawWithNeighbors neighs _wall =
-    str . pure . borderFromEdges unicode $ wallEdges neighs
-
-data Door = Door
-  { _open   :: Bool
-  , _locked :: Bool
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary Door
-makeLenses ''Door
-
-instance Draw Door where
-  drawWithNeighbors neighs door
-    = str . pure . ($ door ^. open) $ case wallEdges neighs of
-        Edges True  False  False False -> vertDoor
-        Edges False True   False False -> vertDoor
-        Edges True  True   False False -> vertDoor
-        Edges False False  True  False -> horizDoor
-        Edges False False  False True  -> horizDoor
-        Edges False False  True  True  -> horizDoor
-        _                              -> allsidesDoor
-    where
-      horizDoor True = '␣'
-      horizDoor False = 'ᚔ'
-      vertDoor True = '['
-      vertDoor False = 'ǂ'
-      allsidesDoor True = '+'
-      allsidesDoor False = '▥'
-
-instance Brain Door where step = brainVia Brainless
-
-instance Entity Door where
-  entityAttributes door = defaultEntityAttributes
-    & blocksVision .~ not (door ^. open)
-  description door | door ^. open = "an open door"
-                   | otherwise    = "a closed door"
-  entityChar _ = "d"
-  entityCollision door | door ^. open = Nothing
-                       | otherwise = Just Stop
-
-closed :: Lens' Door Bool
-closed = open . involuted not
-
--- | A closed, unlocked door
-unlockedDoor :: Door
-unlockedDoor = Door
-  { _open = False
-  , _locked = False
-  }
-
---------------------------------------------------------------------------------
-
-newtype GroundMessage = GroundMessage Text
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary GroundMessage
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ 'TagSingleConstructors 'True
-                        , 'SumEnc 'ObjWithSingleField
-                        ]
-           GroundMessage
-  deriving Draw
-       via DrawStyledCharacter ('Just 'Yellow) 'Nothing "≈"
-           GroundMessage
-instance Brain GroundMessage where step = brainVia Brainless
-
-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
-  description UpStaircase = "a staircase leading upwards"
-  description DownStaircase = "a staircase leading downwards"
-  entityChar UpStaircase = "<"
-  entityChar DownStaircase = ">"
-  entityCollision = const Nothing