From 4b11859d046b470a87d73edc8447ed73a3f7a6da Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Wed, 24 Nov 2021 17:10:47 -0500 Subject: feat(gs/xanthous): Allow generating creatures with items Add an `equippedItems` field to the CreatureType raw, which provides a chance for generating that creature with an item equipped, which goes into a new `inventory` field on the creature entity itself. Currently the creature doesn't actually *use* this equipped item, but it's a step. This commit also adds a broken-dagger equipped 90% of the time to the "husk" creature. Change-Id: I6416c0678ba7bc1b002c5ce6119f7dc97dd86437 --- .../xanthous/src/Xanthous/Entities/Character.hs | 4 +- .../grfn/xanthous/src/Xanthous/Entities/Common.hs | 7 +- .../xanthous/src/Xanthous/Entities/Creature.hs | 26 +------ .../xanthous/src/Xanthous/Entities/RawTypes.hs | 88 ++++++++++++---------- users/grfn/xanthous/src/Xanthous/Entities/Raws.hs | 11 --- .../xanthous/src/Xanthous/Entities/Raws/husk.yaml | 5 +- 6 files changed, 66 insertions(+), 75 deletions(-) (limited to 'users/grfn/xanthous/src/Xanthous/Entities') diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs index b86e9e17d3f9..d405cb40d3eb 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs @@ -6,7 +6,7 @@ module Xanthous.Entities.Character ( -- * Character datatype Character(..) , characterName - , inventory + , HasInventory(..) , characterDamage , characterHitpoints' , characterHitpoints @@ -163,7 +163,7 @@ data Character = Character deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Character -makeLenses ''Character +makeFieldsNoPrefix ''Character characterHitpoints :: Character -> Hitpoints characterHitpoints = views characterHitpoints' floor diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs index 1444f3ce1639..becd1b1ef62e 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs @@ -8,6 +8,7 @@ module Xanthous.Entities.Common ( -- * Inventory Inventory(..) + , HasInventory(..) , backpack , wielded , items @@ -191,6 +192,10 @@ instance Semigroup Inventory where instance Monoid Inventory where mempty = Inventory mempty $ Hands Nothing Nothing +class HasInventory s a | s -> a where + inventory :: Lens' s a + {-# MINIMAL inventory #-} + -- | Representation for where in the inventory an item might be data InventoryPosition = Backpack @@ -224,7 +229,7 @@ itemsWithPosition :: Fold Inventory (InventoryPosition, Item) itemsWithPosition = folding $ (<>) <$> backpackItems <*> handItems where backpackItems = toListOf $ backpack . folded . to (Backpack ,) - handItems inventory = case inventory ^. wielded of + handItems inv = case inv ^. wielded of DoubleHanded i -> pure (BothHands, i ^. wieldedItem) Hands l r -> (l ^.. folded . wieldedItem . to (LeftHand ,)) <> (r ^.. folded . wieldedItem . to (RightHand ,)) diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs index 98dd4dd83331..3af2cafe3349 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs @@ -8,10 +8,9 @@ module Xanthous.Entities.Creature , creatureType , hitpoints , hippocampus + , inventory -- ** Creature functions - , newWithType - , newOnLevelWithType , damage , isDead , visionRadius @@ -33,7 +32,6 @@ import Xanthous.Prelude import Test.QuickCheck import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -import Control.Monad.Random (MonadRandom) -------------------------------------------------------------------------------- import Xanthous.AI.Gormlak import Xanthous.Entities.RawTypes hiding @@ -44,12 +42,14 @@ import Xanthous.Data import Xanthous.Data.Entities import Xanthous.Entities.Creature.Hippocampus import Xanthous.Util.QuickCheck (GenericArbitrary(..)) +import Xanthous.Entities.Common (Inventory) -------------------------------------------------------------------------------- data Creature = Creature { _creatureType :: !CreatureType , _hitpoints :: !Hitpoints , _hippocampus :: !Hippocampus + , _inventory :: !Inventory } deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) @@ -58,7 +58,7 @@ data Creature = Creature deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Creature -makeLenses ''Creature +makeFieldsNoPrefix ''Creature instance HasVisionRadius Creature where visionRadius = const 50 -- TODO @@ -76,24 +76,6 @@ instance Entity Creature where -------------------------------------------------------------------------------- -newOnLevelWithType - :: MonadRandom m - => Word -- ^ Level number, starting at 0 - -> CreatureType - -> m (Maybe Creature) -newOnLevelWithType levelNumber cType - | maybe True (canGenerate levelNumber) $ cType ^. generateParams - = Just <$> newWithType cType - | otherwise - = pure Nothing - - -newWithType :: MonadRandom m => CreatureType -> m Creature -newWithType _creatureType = - let _hitpoints = _creatureType ^. maxHitpoints - _hippocampus = initialHippocampus - in pure Creature {..} - damage :: Hitpoints -> Creature -> Creature damage amount = hitpoints %~ \hp -> if hp <= amount diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs index 761350b01ac0..8453a0533610 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs @@ -30,22 +30,24 @@ module Xanthous.Entities.RawTypes , isWieldable -- * Lens classes - , HasAttacks(..) , HasAttackMessage(..) + , HasAttacks(..) + , HasChance(..) , HasChar(..) , HasDamage(..) , HasDensity(..) , HasDescription(..) , HasEatMessage(..) , HasEdible(..) + , HasEntityName(..) + , HasEquippedItem(..) , HasFriendly(..) , HasGenerateParams(..) , HasHitpointsHealed(..) , HasLanguage(..) + , HasLevelRange(..) , HasLongDescription(..) , HasMaxHitpoints(..) - , HasMaxLevel(..) - , HasMinLevel(..) , HasName(..) , HasSayVerb(..) , HasSpeed(..) @@ -53,19 +55,20 @@ module Xanthous.Entities.RawTypes , HasWieldable(..) ) where -------------------------------------------------------------------------------- -import Xanthous.Prelude -import Test.QuickCheck -import Data.Aeson.Generic.DerivingVia -import Data.Aeson (ToJSON, FromJSON) -import Data.Interval (Interval, lowerBound', upperBound') +import Xanthous.Prelude +import Test.QuickCheck +import Data.Aeson.Generic.DerivingVia +import Data.Aeson (ToJSON, FromJSON) +import Data.Interval (Interval, lowerBound', upperBound') +import qualified Data.Interval as Interval -------------------------------------------------------------------------------- -import Xanthous.Messages (Message(..)) -import Xanthous.Data (TicksPerTile, Hitpoints, Per, Grams, Cubic, Meters) -import Xanthous.Data.EntityChar -import Xanthous.Util.QuickCheck -import Xanthous.Generators.Speech (Language, gormlak, english) -import Xanthous.Orphans () -import Xanthous.Util (EqProp, EqEqProp(..)) +import Xanthous.Messages (Message(..)) +import Xanthous.Data (TicksPerTile, Hitpoints, Per, Grams, Cubic, Meters) +import Xanthous.Data.EntityChar +import Xanthous.Util.QuickCheck +import Xanthous.Generators.Speech (Language, gormlak, english) +import Xanthous.Orphans () +import Xanthous.Util (EqProp, EqEqProp(..)) -------------------------------------------------------------------------------- -- | Identifiers for languages that creatures can speak. @@ -104,13 +107,33 @@ data Attack = Attack Attack makeFieldsNoPrefix ''Attack +-- | Description for generating an item equipped to a creature +data CreatureEquippedItem = CreatureEquippedItem + { -- | Name of the entity type to generate + _entityName :: !Text + -- | Chance of generating the item when generating the creature + -- + -- A chance of 1.0 will always generate the item + , _chance :: !Double + } + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary CreatureEquippedItem + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] + , OmitNothingFields 'True + ] + CreatureEquippedItem +makeFieldsNoPrefix ''CreatureEquippedItem + + data CreatureGenerateParams = CreatureGenerateParams - { -- | Minimum dungeon level at which to generate this creature - _minLevel :: !(Maybe Word) - -- | Maximum dungeon level at which to generate this creature - , _maxLevel :: !(Maybe Word) + { -- | Range of dungeon levels at which to generate this creature + _levelRange :: !(Interval Word) + -- | Item equipped to the creature + , _equippedItem :: !(Maybe CreatureEquippedItem) } - deriving stock (Eq, Show, Ord, Generic) + deriving stock (Eq, Show, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Arbitrary via GenericArbitrary CreatureGenerateParams deriving EqProp via EqEqProp CreatureGenerateParams @@ -119,29 +142,18 @@ data CreatureGenerateParams = CreatureGenerateParams CreatureGenerateParams makeFieldsNoPrefix ''CreatureGenerateParams +instance Ord CreatureGenerateParams where + compare + = (compare `on` lowerBound' . _levelRange) + <> (compare `on` upperBound' . _levelRange) + <> (compare `on` _equippedItem) + -- | Can a creature with these generate params be generated on this level? canGenerate :: Word -- ^ Level number -> CreatureGenerateParams -> Bool -canGenerate levelNumber gps = aboveLowerBound && belowUpperBound - where - aboveLowerBound = withinBound (>=) (gps ^. minLevel) levelNumber - belowUpperBound = withinBound (<=) (gps ^. maxLevel) levelNumber - withinBound cmp bound val = maybe True (cmp val) bound - -instance Semigroup CreatureGenerateParams where - (CreatureGenerateParams minl₁ maxl₁) <> (CreatureGenerateParams minl₂ maxl₂) - = CreatureGenerateParams (addWith min minl₁ minl₂) (addWith max maxl₁ maxl₂) - where - addWith _ Nothing Nothing = Nothing - addWith _ Nothing (Just x) = Just x - addWith _ (Just x) Nothing = Just x - addWith f (Just x) (Just y) = Just (f x y) - -instance Monoid CreatureGenerateParams where - mempty = CreatureGenerateParams Nothing Nothing - +canGenerate levelNumber gps = Interval.member levelNumber $ gps ^. levelRange data CreatureType = CreatureType { _name :: !Text diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs index 441e870160a5..10f0d831934e 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs @@ -5,19 +5,14 @@ module Xanthous.Entities.Raws , raw , RawType(..) , rawsWithType - , entityFromRaw ) where -------------------------------------------------------------------------------- import Data.FileEmbed import qualified Data.Yaml as Yaml import Xanthous.Prelude import System.FilePath.Posix -import Control.Monad.Random (MonadRandom) -------------------------------------------------------------------------------- import Xanthous.Entities.RawTypes -import Xanthous.Game.State -import qualified Xanthous.Entities.Creature as Creature -import qualified Xanthous.Entities.Item as Item import Xanthous.AI.Gormlak () -------------------------------------------------------------------------------- rawRaws :: [(FilePath, ByteString)] @@ -52,9 +47,3 @@ rawsWithType :: forall a. RawType a => HashMap Text a rawsWithType = mapFromList . itoListOf (ifolded . _RawType) $ raws -------------------------------------------------------------------------------- - -entityFromRaw :: MonadRandom m => EntityRaw -> m SomeEntity -entityFromRaw (Creature creatureType) - = SomeEntity <$> Creature.newWithType creatureType -entityFromRaw (Item itemType) - = SomeEntity <$> Item.newWithType itemType diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml index c6f2784fa5c6..cdfcde616d21 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml @@ -20,4 +20,7 @@ Creature: - description: kicks you damage: 2 generateParams: - minLevel: 1 + levelRange: [1, PosInf] + equippedItem: + entityName: broken-dagger + chance: 0.9 -- cgit 1.4.1