diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities')
3 files changed, 99 insertions, 15 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs index f23cf25b4392..98dd4dd83331 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs @@ -11,6 +11,7 @@ module Xanthous.Entities.Creature -- ** Creature functions , newWithType + , newOnLevelWithType , damage , isDead , visionRadius @@ -30,7 +31,6 @@ module Xanthous.Entities.Creature import Xanthous.Prelude -------------------------------------------------------------------------------- import Test.QuickCheck -import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) import Control.Monad.Random (MonadRandom) @@ -43,20 +43,21 @@ import Xanthous.Game.State import Xanthous.Data import Xanthous.Data.Entities import Xanthous.Entities.Creature.Hippocampus +import Xanthous.Util.QuickCheck (GenericArbitrary(..)) -------------------------------------------------------------------------------- data Creature = Creature - { _creatureType :: !CreatureType - , _hitpoints :: !Hitpoints - , _hippocampus :: !Hippocampus + { _creatureType :: !CreatureType + , _hitpoints :: !Hitpoints + , _hippocampus :: !Hippocampus } deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature + deriving Arbitrary via GenericArbitrary Creature deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Creature -instance Arbitrary Creature where arbitrary = genericArbitrary makeLenses ''Creature instance HasVisionRadius Creature where @@ -75,6 +76,18 @@ 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 diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs index b0fb5e086e26..761350b01ac0 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs @@ -10,6 +10,9 @@ module Xanthous.Entities.RawTypes -- * Creatures , CreatureType(..) , hostile + -- ** Generation parameters + , CreatureGenerateParams(..) + , canGenerate -- ** Language , LanguageName(..) , getLanguage @@ -36,10 +39,13 @@ module Xanthous.Entities.RawTypes , HasEatMessage(..) , HasEdible(..) , HasFriendly(..) + , HasGenerateParams(..) , HasHitpointsHealed(..) , HasLanguage(..) , HasLongDescription(..) , HasMaxHitpoints(..) + , HasMaxLevel(..) + , HasMinLevel(..) , HasName(..) , HasSayVerb(..) , HasSpeed(..) @@ -51,6 +57,7 @@ import Xanthous.Prelude import Test.QuickCheck import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) +import Data.Interval (Interval, lowerBound', upperBound') -------------------------------------------------------------------------------- import Xanthous.Messages (Message(..)) import Xanthous.Data (TicksPerTile, Hitpoints, Per, Grams, Cubic, Meters) @@ -58,7 +65,7 @@ import Xanthous.Data.EntityChar import Xanthous.Util.QuickCheck import Xanthous.Generators.Speech (Language, gormlak, english) import Xanthous.Orphans () -import Data.Interval (Interval, lowerBound', upperBound') +import Xanthous.Util (EqProp, EqEqProp(..)) -------------------------------------------------------------------------------- -- | Identifiers for languages that creatures can speak. @@ -97,18 +104,59 @@ data Attack = Attack Attack makeFieldsNoPrefix ''Attack +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) + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary CreatureGenerateParams + deriving EqProp via EqEqProp CreatureGenerateParams + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + CreatureGenerateParams +makeFieldsNoPrefix ''CreatureGenerateParams + +-- | 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 + + data CreatureType = CreatureType - { _name :: !Text - , _description :: !Text - , _char :: !EntityChar - , _maxHitpoints :: !Hitpoints - , _friendly :: !Bool - , _speed :: !TicksPerTile - , _language :: !(Maybe LanguageName) + { _name :: !Text + , _description :: !Text + , _char :: !EntityChar + , _maxHitpoints :: !Hitpoints + , _friendly :: !Bool + , _speed :: !TicksPerTile + , _language :: !(Maybe LanguageName) , -- | The verb, in present tense, for when the creature says something - _sayVerb :: !(Maybe Text) + _sayVerb :: !(Maybe Text) , -- | The creature's natural attacks - _attacks :: !(NonNull (Vector Attack)) + _attacks :: !(NonNull (Vector Attack)) + -- | Parameters for generating the creature in levels + , _generateParams :: !(Maybe CreatureGenerateParams) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml new file mode 100644 index 000000000000..c6f2784fa5c6 --- /dev/null +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml @@ -0,0 +1,23 @@ +Creature: + name: husk + description: an empty husk of some humanoid creature + longDescription: | + An empty husk of a humanoid creature. All semblance of sentience has long + left its eyes; instead it shambles about aimlessly, always hungering for the + warmth of life. + char: + char: h + style: + foreground: black + maxHitpoints: 6 + speed: 110 + friendly: false + attacks: + - description: + - swings its arms at you + - elbows you + damage: 1 + - description: kicks you + damage: 2 + generateParams: + minLevel: 1 |