Add messages on the ground

Add support for a "GroundMessage" entity type, support for a Read
command to read them, and randomly place an initial, tone-setting
tutorial message on the ground near the character at the beginning of
the game.
This commit is contained in:
Griffin Smith 2019-11-30 19:55:43 -05:00
parent 4431d453f6
commit 71b628c604
12 changed files with 210 additions and 40 deletions

View file

@ -1,22 +1,29 @@
{-# LANGUAGE TemplateHaskell #-}
module Xanthous.Entities.Environment
( Wall(..)
(
-- * Walls
Wall(..)
-- * Doors
, Door(..)
, open
, locked
-- * Messages
, GroundMessage(..)
) 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 Data.Aeson
import Data.Aeson.Generic.DerivingVia
--------------------------------------------------------------------------------
import Xanthous.Entities.Draw.Util
import Xanthous.Data
import Xanthous.Game.State
import Xanthous.Util.QuickCheck
--------------------------------------------------------------------------------
data Wall = Wall
@ -31,7 +38,6 @@ instance FromJSON Wall where
"Wall" -> pure Wall
_ -> fail "Invalid Wall: expected Wall"
-- deriving via Brainless Wall instance Brain Wall
instance Brain Wall where step = brainVia Brainless
instance Entity Wall where
@ -56,11 +62,9 @@ data Door = Door
}
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
deriving Arbitrary via GenericArbitrary Door
makeLenses ''Door
instance Arbitrary Door where
arbitrary = genericArbitrary
instance Draw Door where
drawWithNeighbors neighs door
| door ^. open
@ -77,10 +81,29 @@ instance Draw Door where
horizDoor = '␣'
vertDoor = '['
-- deriving via Brainless Door instance Brain Door
instance Brain Door where step = brainVia Brainless
instance Entity Door where
blocksVision = not . view open
description _ = "a door"
entityChar _ = "d"
--------------------------------------------------------------------------------
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
deriving Entity
via DeriveEntity 'False "a message on the ground. Press r. to read it."
""
GroundMessage
instance Brain GroundMessage where step = brainVia Brainless