diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities')
4 files changed, 32 insertions, 14 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs index e95e9f0b985b..f23cf25b4392 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs @@ -33,6 +33,7 @@ import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) +import Control.Monad.Random (MonadRandom) -------------------------------------------------------------------------------- import Xanthous.AI.Gormlak import Xanthous.Entities.RawTypes hiding @@ -74,11 +75,11 @@ instance Entity Creature where -------------------------------------------------------------------------------- -newWithType :: CreatureType -> Creature +newWithType :: MonadRandom m => CreatureType -> m Creature newWithType _creatureType = let _hitpoints = _creatureType ^. maxHitpoints _hippocampus = initialHippocampus - in Creature {..} + in pure Creature {..} damage :: Hitpoints -> Creature -> Creature damage amount = hitpoints %~ \hp -> diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Item.hs b/users/grfn/xanthous/src/Xanthous/Entities/Item.hs index b50a5eab809d..6647c42731fa 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Item.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Item.hs @@ -1,49 +1,63 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- module Xanthous.Entities.Item ( Item(..) , itemType + , density + , volume , newWithType , isEdible + , weight ) where -------------------------------------------------------------------------------- import Xanthous.Prelude -import Test.QuickCheck +import Test.QuickCheck (Arbitrary, CoArbitrary, Function) import Data.Aeson (ToJSON, FromJSON) import Data.Aeson.Generic.DerivingVia +import Control.Monad.Random (MonadRandom) -------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes hiding (Item, description, isEdible) +import Xanthous.Entities.RawTypes (ItemType) import qualified Xanthous.Entities.RawTypes as Raw import Xanthous.Game.State +import Xanthous.Data (Grams, Per, Cubic, Meters, (|*|)) +import Xanthous.Util.QuickCheck (GenericArbitrary(GenericArbitrary)) +import Xanthous.Random (choose, FiniteInterval(..)) -------------------------------------------------------------------------------- data Item = Item { _itemType :: ItemType + , _density :: Grams `Per` Cubic Meters + , _volume :: Cubic Meters } deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Draw via DrawRawChar "_itemType" Item + deriving Arbitrary via GenericArbitrary Item deriving (ToJSON, FromJSON) via WithOptions '[ FieldLabelModifier '[Drop 1] ] Item makeLenses ''Item -{-# ANN Item ("HLint: ignore Use newtype instead of data" :: String )#-} - -- deriving via (Brainless Item) instance Brain Item instance Brain Item where step = brainVia Brainless -instance Arbitrary Item where - arbitrary = Item <$> arbitrary - instance Entity Item where description = view $ itemType . Raw.description entityChar = view $ itemType . Raw.char entityCollision = const Nothing -newWithType :: ItemType -> Item -newWithType = Item +newWithType :: MonadRandom m => ItemType -> m Item +newWithType _itemType = do + _density <- choose . FiniteInterval $ _itemType ^. Raw.density + _volume <- choose . FiniteInterval $ _itemType ^. Raw.volume + pure Item {..} isEdible :: Item -> Bool isEdible = Raw.isEdible . view itemType + +-- | The weight of this item, calculated by multiplying its volume by the +-- density of its material +weight :: Item -> Grams +weight item = (item ^. density) |*| (item ^. volume) diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs index 88070ed7b8bd..b0fb5e086e26 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs @@ -31,6 +31,7 @@ module Xanthous.Entities.RawTypes , HasAttackMessage(..) , HasChar(..) , HasDamage(..) + , HasDensity(..) , HasDescription(..) , HasEatMessage(..) , HasEdible(..) @@ -42,6 +43,7 @@ module Xanthous.Entities.RawTypes , HasName(..) , HasSayVerb(..) , HasSpeed(..) + , HasVolume(..) , HasWieldable(..) ) where -------------------------------------------------------------------------------- diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs index d4cae7ccc299..441e870160a5 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs @@ -12,6 +12,7 @@ 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 @@ -52,8 +53,8 @@ rawsWithType = mapFromList . itoListOf (ifolded . _RawType) $ raws -------------------------------------------------------------------------------- -entityFromRaw :: EntityRaw -> SomeEntity +entityFromRaw :: MonadRandom m => EntityRaw -> m SomeEntity entityFromRaw (Creature creatureType) - = SomeEntity $ Creature.newWithType creatureType + = SomeEntity <$> Creature.newWithType creatureType entityFromRaw (Item itemType) - = SomeEntity $ Item.newWithType itemType + = SomeEntity <$> Item.newWithType itemType |