From 9ebdc6fbb446fea5e505172a6b3dd459beaf3552 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Mon, 9 Sep 2019 20:54:33 -0400 Subject: Convert generated levels to walls Add support for converting generated levels to walls, and merge one into the entity map at the beginning of the game. There's nothing here that guarantees the character ends up *inside* the level though (they almost always don't) so that'll have to be slotted into the level generation process. --- src/Xanthous/Entities/Arbitrary.hs | 19 +++++++++++++++++++ src/Xanthous/Entities/Character.hs | 8 ++++---- src/Xanthous/Entities/Draw/Util.hs | 31 +++++++++++++++++++++++++++++++ src/Xanthous/Entities/Environment.hs | 26 ++++++++++++++++++++++++++ src/Xanthous/Entities/RawTypes.hs | 2 +- src/Xanthous/Entities/SomeEntity.hs | 34 ---------------------------------- 6 files changed, 81 insertions(+), 39 deletions(-) create mode 100644 src/Xanthous/Entities/Arbitrary.hs create mode 100644 src/Xanthous/Entities/Draw/Util.hs create mode 100644 src/Xanthous/Entities/Environment.hs delete mode 100644 src/Xanthous/Entities/SomeEntity.hs (limited to 'src/Xanthous/Entities') diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs new file mode 100644 index 000000000000..9153722d9b12 --- /dev/null +++ b/src/Xanthous/Entities/Arbitrary.hs @@ -0,0 +1,19 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------------------- +module Xanthous.Entities.Arbitrary () where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Test.QuickCheck +import qualified Test.QuickCheck.Gen as Gen +-------------------------------------------------------------------------------- +import Xanthous.Entities (SomeEntity(..)) +import Xanthous.Entities.Character +import Xanthous.Entities.Environment +-------------------------------------------------------------------------------- + +instance Arbitrary SomeEntity where + arbitrary = Gen.oneof + [ pure $ SomeEntity Character + , pure $ SomeEntity Wall + ] diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index 5cf397e82232..faa9964a3833 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -2,14 +2,14 @@ module Xanthous.Entities.Character ( Character(..) , mkCharacter ) where - +-------------------------------------------------------------------------------- import Xanthous.Prelude import Test.QuickCheck - +-------------------------------------------------------------------------------- import Xanthous.Entities +-------------------------------------------------------------------------------- -data Character where - Character :: Character +data Character = Character deriving stock (Show, Eq, Ord, Generic) deriving anyclass (CoArbitrary, Function) deriving Draw via (DrawCharacter "@" Character) diff --git a/src/Xanthous/Entities/Draw/Util.hs b/src/Xanthous/Entities/Draw/Util.hs new file mode 100644 index 000000000000..aa6c5fa4fc47 --- /dev/null +++ b/src/Xanthous/Entities/Draw/Util.hs @@ -0,0 +1,31 @@ +module Xanthous.Entities.Draw.Util where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +-------------------------------------------------------------------------------- +import Brick.Widgets.Border.Style +import Brick.Types (Edges(..)) +-------------------------------------------------------------------------------- + +borderFromEdges :: BorderStyle -> Edges Bool -> Char +borderFromEdges bstyle edges = ($ bstyle) $ case edges of + Edges False False False False -> const '☐' + + Edges True False False False -> bsVertical + Edges False True False False -> bsVertical + Edges False False True False -> bsHorizontal + Edges False False False True -> bsHorizontal + + Edges True True False False -> bsVertical + Edges True False True False -> bsCornerBR + Edges True False False True -> bsCornerBL + + Edges False True True False -> bsCornerTR + Edges False True False True -> bsCornerTL + Edges False False True True -> bsHorizontal + + Edges False True True True -> bsIntersectT + Edges True False True True -> bsIntersectB + Edges True True False True -> bsIntersectL + Edges True True True False -> bsIntersectR + + Edges True True True True -> bsIntersectFull diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs new file mode 100644 index 000000000000..f5301f94adf2 --- /dev/null +++ b/src/Xanthous/Entities/Environment.hs @@ -0,0 +1,26 @@ +module Xanthous.Entities.Environment + ( Wall(..) + ) where +-------------------------------------------------------------------------------- +import Xanthous.Prelude +import Test.QuickCheck +import Brick (str) +import Brick.Widgets.Border.Style (unicode) +-------------------------------------------------------------------------------- +import Xanthous.Entities (Draw(..), entityIs) +import Xanthous.Entities.Draw.Util +import Xanthous.Data +-------------------------------------------------------------------------------- + +data Wall = Wall + deriving stock (Show, Eq, Ord, Generic, Enum) + deriving anyclass (CoArbitrary, Function) + +instance Arbitrary Wall where + arbitrary = pure Wall + +instance Draw Wall where + drawWithNeighbors neighs _wall = + str . pure . borderFromEdges unicode $ wallEdges + where + wallEdges = any (entityIs @Wall) <$> edges neighs diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs index e82cb0c890c7..88087a5dab61 100644 --- a/src/Xanthous/Entities/RawTypes.hs +++ b/src/Xanthous/Entities/RawTypes.hs @@ -20,7 +20,7 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (FromJSON) import Data.Word -import Xanthous.Data +import Xanthous.Entities (EntityChar) data CreatureType = CreatureType { _name :: Text diff --git a/src/Xanthous/Entities/SomeEntity.hs b/src/Xanthous/Entities/SomeEntity.hs deleted file mode 100644 index 029247de9b7f..000000000000 --- a/src/Xanthous/Entities/SomeEntity.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE GADTs #-} -module Xanthous.Entities.SomeEntity - ( SomeEntity(..) - , downcastEntity - ) where - -import Xanthous.Prelude -import Test.QuickCheck (Arbitrary(..)) -import qualified Test.QuickCheck.Gen as Gen - -import Xanthous.Entities (Draw(..), Entity) -import Data.Typeable -import Xanthous.Entities.Character - -data SomeEntity where - SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity - -instance Show SomeEntity where - show (SomeEntity x) = "SomeEntity (" <> show x <> ")" - -instance Eq SomeEntity where - (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of - Just Refl -> a == b - _ -> False - -instance Arbitrary SomeEntity where - arbitrary = Gen.oneof - [pure $ SomeEntity Character] - -instance Draw SomeEntity where - draw (SomeEntity ent) = draw ent - -downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a -downcastEntity (SomeEntity e) = cast e -- cgit 1.4.1