{-# LANGUAGE TemplateHaskell #-}
module Xanthous.Entities.Environment
( Wall(..)
, Door(..)
, open
, locked
) where
--------------------------------------------------------------------------------
import Xanthous.Prelude
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.Generic
import Brick (str)
import Brick.Widgets.Border.Style (unicode)
import Brick.Types (Edges(..))
--------------------------------------------------------------------------------
import Xanthous.Entities (Draw(..), entityIs, Entity(..), SomeEntity)
import Xanthous.Entities.Draw.Util
import Xanthous.Data
--------------------------------------------------------------------------------
data Wall = Wall
deriving stock (Show, Eq, Ord, Generic, Enum)
deriving anyclass (CoArbitrary, Function)
instance Entity Wall where
blocksVision _ = True
description _ = "a wall"
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)
makeLenses ''Door
instance Arbitrary Door where
arbitrary = genericArbitrary
instance Draw Door where
drawWithNeighbors neighs door
| door ^. open
= str . pure $ 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
_ -> '+'
| otherwise = str "\\"
where
horizDoor = '␣'
vertDoor = '['
instance Entity Door where
blocksVision = not . view open
description _ = "a door"
