From 5b1c7799a76480335f838356ad78bed50715d4c0 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 22 Dec 2019 22:46:43 -0500 Subject: Add wielded, wieldable items Split the character's inventory up into wielded items (in one or both hands) and the backpack, and display wielded items when drawing the inventory panel. Currently there's no way to actually *wield* items though, so this is all unused/untested. Also, add the ability for items to be "wieldable", which gives specific descriptions for when attacking with them and also modified damage. --- src/Xanthous/Entities/Character.hs | 157 ++++++++++++++++++++++++++++++++++++- 1 file changed, 154 insertions(+), 3 deletions(-) (limited to 'src/Xanthous/Entities/Character.hs') diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs index dd14390df979..5ddf33c29434 100644 --- a/src/Xanthous/Entities/Character.hs +++ b/src/Xanthous/Entities/Character.hs @@ -10,6 +10,22 @@ module Xanthous.Entities.Character , hitpointRecoveryRate , speed + -- * Inventory + , Inventory(..) + , backpack + , wielded + , items + -- ** Wielded items + , Wielded(..) + , hands + , leftHand + , rightHand + , doubleHanded + , wieldedItems + , WieldedItem(..) + , wieldedItem + , wieldableItem + -- * , mkCharacter , pickUpItem @@ -27,13 +43,148 @@ import Data.Aeson.Generic.DerivingVia import Data.Aeson (ToJSON, FromJSON) import Data.Coerce (coerce) -------------------------------------------------------------------------------- +import Xanthous.Util.QuickCheck import Xanthous.Game.State import Xanthous.Entities.Item -import Xanthous.Data (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned) +import Xanthous.Data + (TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned, Positioned(..)) +import Xanthous.Entities.RawTypes (WieldableItem, wieldable) +-------------------------------------------------------------------------------- + +data WieldedItem = WieldedItem + { _wieldedItem :: Item + , _wieldableItem :: WieldableItem + -- ^ Invariant: item ^. itemType . wieldable ≡ Just wieldableItem + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + WieldedItem +makeFieldsNoPrefix ''WieldedItem + +instance Brain WieldedItem where + step ticks (Positioned p wi) = + over positioned (\i -> WieldedItem i $ wi ^. wieldableItem) + <$> step ticks (Positioned p $ wi ^. wieldedItem) + +instance Draw WieldedItem where + draw = draw . view wieldedItem + +instance Entity WieldedItem where + blocksVision = blocksVision . view wieldedItem + description = description . view wieldedItem + entityChar = entityChar . view wieldedItem + +instance Arbitrary WieldedItem where + arbitrary = genericArbitrary <&> \wi -> + wi & wieldedItem . itemType . wieldable ?~ wi ^. wieldableItem + +data Wielded + = DoubleHanded WieldedItem + | Hands { _leftHand :: !(Maybe WieldedItem) + , _rightHand :: !(Maybe WieldedItem) + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Wielded + deriving (ToJSON, FromJSON) + via WithOptions '[ 'SumEnc 'ObjWithSingleField ] + Wielded + +hands :: Prism' Wielded (Maybe WieldedItem, Maybe WieldedItem) +hands = prism' (uncurry Hands) $ \case + Hands l r -> Just (l, r) + _ -> Nothing + +leftHand :: Traversal' Wielded WieldedItem +leftHand = hands . _1 . _Just + +rightHand :: Traversal' Wielded WieldedItem +rightHand = hands . _2 . _Just + +doubleHanded :: Prism' Wielded WieldedItem +doubleHanded = prism' DoubleHanded $ \case + DoubleHanded i -> Just i + _ -> Nothing + +wieldedItems :: Traversal' Wielded Item +wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> wieldedItem k wielded +wieldedItems k (Hands l r) = Hands + <$> (_Just . wieldedItem) k l + <*> (_Just . wieldedItem) k r + +data Inventory = Inventory + { _backpack :: Vector Item + , _wielded :: Wielded + } + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Inventory + deriving (ToJSON, FromJSON) + via WithOptions '[ FieldLabelModifier '[Drop 1] ] + Inventory +makeFieldsNoPrefix ''Inventory + +items :: Traversal' Inventory Item +items k (Inventory bp w) = Inventory + <$> traversed k bp + <*> wieldedItems k w + +type instance Element Inventory = Item + +instance MonoFunctor Inventory where + omap = over items + +instance MonoFoldable Inventory where + ofoldMap = foldMapOf items + ofoldr = foldrOf items + ofoldl' = foldlOf' items + otoList = toListOf items + oall = allOf items + oany = anyOf items + onull = nullOf items + ofoldr1Ex = foldr1Of items + ofoldl1Ex' = foldl1Of' items + headEx = headEx . toListOf items + lastEx = lastEx . toListOf items + +instance MonoTraversable Inventory where + otraverse = traverseOf items + +instance Semigroup Inventory where + inv₁ <> inv₂ = + let backpack' = inv₁ ^. backpack <> inv₂ ^. backpack + (wielded', backpack'') = case (inv₁ ^. wielded, inv₂ ^. wielded) of + (wielded₁, wielded₂@(DoubleHanded _)) -> + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems)) + (wielded₁, wielded₂@(Hands (Just _) (Just _))) -> + (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems)) + (wielded₁, Hands Nothing Nothing) -> (wielded₁, backpack') + (Hands Nothing Nothing, wielded₂) -> (wielded₂, backpack') + (Hands (Just l₁) Nothing, Hands Nothing (Just r₂)) -> + (Hands (Just l₁) (Just r₂), backpack') + (wielded₁@(DoubleHanded _), wielded₂) -> + (wielded₁, backpack' <> fromList (wielded₂ ^.. wieldedItems)) + (Hands Nothing (Just r₁), Hands Nothing (Just r₂)) -> + (Hands Nothing (Just r₂), r₁ ^. wieldedItem <| backpack') + (Hands Nothing r₁, Hands (Just l₂) Nothing) -> + (Hands (Just l₂) r₁, backpack') + (Hands (Just l₁) Nothing, Hands (Just l₂) Nothing) -> + (Hands (Just l₂) Nothing, l₁ ^. wieldedItem <| backpack') + (Hands (Just l₁) (Just r₁), Hands Nothing (Just r₂)) -> + (Hands (Just l₁) (Just r₂), r₁ ^. wieldedItem <| backpack') + (Hands (Just l₁) (Just r₁), Hands (Just l₂) Nothing) -> + (Hands (Just l₂) (Just r₁), l₁ ^. wieldedItem <| backpack') + in Inventory backpack'' wielded' + +instance Monoid Inventory where + mempty = Inventory mempty $ Hands Nothing Nothing + -------------------------------------------------------------------------------- data Character = Character - { _inventory :: !(Vector Item) + { _inventory :: !Inventory , _characterName :: !(Maybe Text) , _characterDamage :: !Hitpoints , _characterHitpoints' :: !Double @@ -95,7 +246,7 @@ isDead :: Character -> Bool isDead = (== 0) . characterHitpoints pickUpItem :: Item -> Character -> Character -pickUpItem item = inventory %~ (item <|) +pickUpItem it = inventory . backpack %~ (it <|) damage :: Hitpoints -> Character -> Character damage (fromIntegral -> amount) = characterHitpoints' %~ \case -- cgit 1.4.1