diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs')
| -rw-r--r-- | users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs | 286 |
1 files changed, 0 insertions, 286 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs deleted file mode 100644 index a7021d76cf..0000000000 --- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs +++ /dev/null @@ -1,286 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DuplicateRecordFields #-} --------------------------------------------------------------------------------- -module Xanthous.Entities.RawTypes - ( - EntityRaw(..) - , _Creature - , _Item - - -- * Creatures - , CreatureType(..) - , hostile - -- ** Generation parameters - , CreatureGenerateParams(..) - , canGenerate - -- ** Language - , LanguageName(..) - , getLanguage - -- ** Attacks - , Attack(..) - - -- * Items - , ItemType(..) - -- ** Item sub-types - -- *** Edible - , EdibleItem(..) - , isEdible - -- *** Wieldable - , WieldableItem(..) - , isWieldable - - -- * Lens classes - , HasAttackMessage(..) - , HasAttacks(..) - , HasChance(..) - , HasChar(..) - , HasCreatureAttackMessage(..) - , HasDamage(..) - , HasDensity(..) - , HasDescription(..) - , HasEatMessage(..) - , HasEdible(..) - , HasEntityName(..) - , HasEquippedItem(..) - , HasFriendly(..) - , HasGenerateParams(..) - , HasHitpointsHealed(..) - , HasLanguage(..) - , HasLevelRange(..) - , HasLongDescription(..) - , HasMaxHitpoints(..) - , HasName(..) - , HasSayVerb(..) - , HasSpeed(..) - , HasVolume(..) - , 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 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(..)) --------------------------------------------------------------------------------- - --- | Identifiers for languages that creatures can speak. --- --- Non-verbal or non-sentient creatures have Nothing as their language --- --- At some point, we will likely want to make languages be defined in data files --- somewhere, and reference them that way instead. -data LanguageName = Gormlak | English - deriving stock (Show, Eq, Ord, Generic, Enum, Bounded) - deriving anyclass (NFData, CoArbitrary, Function) - deriving Arbitrary via GenericArbitrary LanguageName - deriving (ToJSON, FromJSON) - via WithOptions '[ AllNullaryToStringTag 'True ] - LanguageName - --- | Resolve a 'LanguageName' into an actual 'Language' -getLanguage :: LanguageName -> Language -getLanguage Gormlak = gormlak -getLanguage English = english - --- | Natural attacks for creature types -data Attack = Attack - { -- | the @{{creature}}@ @{{description}}@ - _description :: !Message - -- | Damage dealt - , _damage :: !Hitpoints - } - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving Arbitrary via GenericArbitrary Attack - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] - , OmitNothingFields 'True - ] - 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 - { -- | 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, 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 - -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 = Interval.member levelNumber $ gps ^. levelRange - -data CreatureType = CreatureType - { _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) - , -- | The creature's natural attacks - _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) - deriving Arbitrary via GenericArbitrary CreatureType - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] - , OmitNothingFields 'True - ] - CreatureType -makeFieldsNoPrefix ''CreatureType - -hostile :: Lens' CreatureType Bool -hostile = friendly . involuted not - --------------------------------------------------------------------------------- - -data EdibleItem = EdibleItem - { _hitpointsHealed :: !Int - , _eatMessage :: !(Maybe Message) - } - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving Arbitrary via GenericArbitrary EdibleItem - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] ] - EdibleItem -makeFieldsNoPrefix ''EdibleItem - -data WieldableItem = WieldableItem - { _damage :: !Hitpoints - -- | Message to use when the character is using this item to attack a - -- creature. - -- - -- Grammatically, this should be of the form "slash at the - -- {{creature.creatureType.name}} with your dagger" - -- - -- = Parameters - -- - -- [@creature@ (type: 'Creature')] The creature being attacked - , _attackMessage :: !(Maybe Message) - -- | Message to use when a creature is using this item to attack the - -- character. - -- - -- Grammatically, should be of the form "The creature slashes you with its - -- dagger". - -- - -- = Parameters - -- - -- [@creature@ (type: 'Creature')] The creature doing the attacking - -- [@item@ (type: 'Item')] The item itself - , _creatureAttackMessage :: !(Maybe Message) - } - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving Arbitrary via GenericArbitrary WieldableItem - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] ] - WieldableItem -makeFieldsNoPrefix ''WieldableItem - --------------------------------------------------------------------------------- - -data ItemType = ItemType - { _name :: !Text - , _description :: !Text - , _longDescription :: !Text - , _char :: !EntityChar - , _density :: !(Interval (Grams `Per` Cubic Meters)) - , _volume :: !(Interval (Cubic Meters)) - , _edible :: !(Maybe EdibleItem) - , _wieldable :: !(Maybe WieldableItem) - } - deriving stock (Show, Eq, Generic) - deriving anyclass (NFData, CoArbitrary, Function) - deriving Arbitrary via GenericArbitrary ItemType - deriving (ToJSON, FromJSON) - via WithOptions '[ FieldLabelModifier '[Drop 1] ] - ItemType -makeFieldsNoPrefix ''ItemType - -instance Ord ItemType where - compare x y - = compareOf name x y - <> compareOf description x y - <> compareOf longDescription x y - <> compareOf char x y - <> compareOf (density . to extractInterval) x y - <> compareOf (volume . to extractInterval) x y - <> compareOf edible x y - <> compareOf wieldable x y - where - compareOf l = comparing (view l) - extractInterval = lowerBound' &&& upperBound' - --- | Can this item be eaten? -isEdible :: ItemType -> Bool -isEdible = has $ edible . _Just - --- | Can this item be used as a weapon? -isWieldable :: ItemType -> Bool -isWieldable = has $ wieldable . _Just - --------------------------------------------------------------------------------- - -data EntityRaw - = Creature !CreatureType - | Item !ItemType - deriving stock (Show, Eq, Generic) - deriving anyclass (NFData) - deriving Arbitrary via GenericArbitrary EntityRaw - deriving (FromJSON) - via WithOptions '[ SumEnc ObjWithSingleField ] - EntityRaw -makePrisms ''EntityRaw |