diff options
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs')
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs index b7c5fe31c995..88070ed7b8bd 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs @@ -51,11 +51,12 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) -------------------------------------------------------------------------------- import Xanthous.Messages (Message(..)) -import Xanthous.Data (TicksPerTile, Hitpoints) +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 Data.Interval (Interval, lowerBound', upperBound') -------------------------------------------------------------------------------- -- | Identifiers for languages that creatures can speak. @@ -153,10 +154,12 @@ data ItemType = ItemType , _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, Ord, Generic) + deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Arbitrary via GenericArbitrary ItemType deriving (ToJSON, FromJSON) @@ -164,6 +167,20 @@ data ItemType = ItemType 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 |