From 632c4280b5c8ad717a7ce7b08c49ad93630c8db4 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sat, 16 Apr 2022 16:01:04 -0400 Subject: [PATCH] feat(xanthous): Allow selecting hand for wielding When wielding items, allow selecting which hand the item should be wielded in. Currently this has no actual effect on the mechanics of combat - that'll come next. Change-Id: Ic289ca2d8fa6f5fc0ad5bd0b012818a3acd8599e Reviewed-on: https://cl.tvl.fyi/c/depot/+/5470 Reviewed-by: grfn Autosubmit: grfn Tested-by: BuildkiteCI --- users/grfn/xanthous/src/Xanthous/App.hs | 34 ++++++--- .../xanthous/src/Xanthous/Entities/Common.hs | 72 ++++++++++++++----- .../grfn/xanthous/src/Xanthous/messages.yaml | 4 +- .../test/Xanthous/Entities/CommonSpec.hs | 39 +++++++++- 4 files changed, 119 insertions(+), 30 deletions(-) diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs index d4ffb2263..fdc648dda 100644 --- a/users/grfn/xanthous/src/Xanthous/App.hs +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -54,12 +54,12 @@ import Xanthous.Physics (throwDistance, bluntThrowDamage) import Xanthous.Data.EntityMap.Graphics (lineOfSight) import Xanthous.Data.EntityMap (EntityID) -------------------------------------------------------------------------------- --------------------------------------------------------------------------------- import Xanthous.Entities.Common ( InventoryPosition, describeInventoryPosition, backpack , wieldableItem, wieldedItems, wielded, itemsWithPosition - , removeItemFromPosition, asWieldedItem, inRightHand - , wieldedItem, items + , removeItemFromPosition, asWieldedItem + , wieldedItem, items, Hand (..), describeHand, wieldInHand + , WieldedItem ) import qualified Xanthous.Entities.Character as Character import Xanthous.Entities.Character hiding (pickUpItem) @@ -296,14 +296,30 @@ handleCommand DescribeInventory = do handleCommand Wield = do - takeItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem - (say_ ["wield", "nothing"]) - $ \(MenuResult item) -> do - prevItems <- character . inventory . wielded <<.= inRightHand item + selectItem $ \(MenuResult (item :: WieldedItem)) -> do + selectHand $ \(MenuResult hand) -> do + prevItems <- character . inventory . wielded %%= wieldInHand hand item character . inventory . backpack - <>= fromList (prevItems ^.. wieldedItems . wieldedItem) - say ["wield", "wielded"] item + <>= fromList (map (view wieldedItem) prevItems) + say ["wield", "wielded"] $ object [ "item" A..= item + , "hand" A..= describeHand hand + ] continue + where + selectItem = + takeItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem + (say_ ["wield", "nothing"]) + selectHand + = menu_ + ["wield", "hand"] + Cancellable + handsMenu + handsMenu = mapFromList + . map (second $ MenuOption =<< describeHand) + $ [ ('l', LeftHand) + , ('r', RightHand) + , ('b', BothHands) + ] handleCommand Fire = do selectItemFromInventory_ ["fire", "menu"] Cancellable id diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs index becd1b1ef..368b03f25 100644 --- a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs +++ b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs @@ -20,12 +20,18 @@ module Xanthous.Entities.Common -- ** Wielded items , Wielded(..) + , nothingWielded , hands , leftHand , rightHand , inLeftHand , inRightHand , doubleHanded + , Hand(..) + , itemsInHand + , inHand + , wieldInHand + , describeHand , wieldedItems , WieldedItem(..) , wieldedItem @@ -95,6 +101,7 @@ data Wielded via WithOptions '[ 'SumEnc 'ObjWithSingleField ] Wielded + nothingWielded :: Wielded nothingWielded = Hands Nothing Nothing @@ -124,6 +131,43 @@ wieldedItems :: Traversal' Wielded WieldedItem wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> k wielded wieldedItems k (Hands l r) = Hands <$> _Just k l <*> _Just k r + +data Hand + = LeftHand + | RightHand + | BothHands + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (NFData, CoArbitrary, Function) + deriving Arbitrary via GenericArbitrary Hand + +itemsInHand :: Hand -> Wielded -> [WieldedItem] +itemsInHand LeftHand (DoubleHanded wi) = [wi] +itemsInHand LeftHand (Hands lh _) = toList lh +itemsInHand RightHand (DoubleHanded wi) = [wi] +itemsInHand RightHand (Hands _ rh) = toList rh +itemsInHand BothHands (DoubleHanded wi) = [wi] +itemsInHand BothHands (Hands lh rh) = toList lh <> toList rh + +inHand :: Hand -> WieldedItem -> Wielded +inHand LeftHand = inLeftHand +inHand RightHand = inRightHand +inHand BothHands = review doubleHanded + +wieldInHand :: Hand -> WieldedItem -> Wielded -> ([WieldedItem], Wielded) +wieldInHand hand item w = (itemsInHand hand w, doWield) + where + doWield = case (hand, w) of + (LeftHand, Hands _ r) -> Hands (Just item) r + (LeftHand, DoubleHanded _) -> inLeftHand item + (RightHand, Hands l _) -> Hands l (Just item) + (RightHand, DoubleHanded _) -> inRightHand item + (BothHands, _) -> DoubleHanded item + +describeHand :: Hand -> Text +describeHand LeftHand = "your left hand" +describeHand RightHand = "your right hand" +describeHand BothHands = "both hands" + data Inventory = Inventory { _backpack :: Vector Item , _wielded :: Wielded @@ -199,27 +243,23 @@ class HasInventory s a | s -> a where -- | Representation for where in the inventory an item might be data InventoryPosition = Backpack - | LeftHand - | RightHand - | BothHands + | InHand Hand deriving stock (Eq, Show, Ord, Generic) deriving anyclass (NFData, CoArbitrary, Function) deriving Arbitrary via GenericArbitrary InventoryPosition -- | Return a human-readable description of the given 'InventoryPosition' describeInventoryPosition :: InventoryPosition -> Text -describeInventoryPosition Backpack = "In backpack" -describeInventoryPosition LeftHand = "Wielded, in left hand" -describeInventoryPosition RightHand = "Wielded, in right hand" -describeInventoryPosition BothHands = "Wielded, in both hands" +describeInventoryPosition Backpack = "In backpack" +describeInventoryPosition (InHand hand) = "Wielded, in " <> describeHand hand -- | Given a position in the inventory, return a traversal on the inventory over -- all the items in that position inventoryPosition :: InventoryPosition -> Traversal' Inventory Item inventoryPosition Backpack = backpack . traversed -inventoryPosition LeftHand = wielded . leftHand . _Just . wieldedItem -inventoryPosition RightHand = wielded . leftHand . _Just . wieldedItem -inventoryPosition BothHands = wielded . doubleHanded . wieldedItem +inventoryPosition (InHand LeftHand) = wielded . leftHand . _Just . wieldedItem +inventoryPosition (InHand RightHand) = wielded . leftHand . _Just . wieldedItem +inventoryPosition (InHand BothHands) = wielded . doubleHanded . wieldedItem -- | A fold over all the items in the inventory accompanied by their position in -- the inventory @@ -230,20 +270,20 @@ itemsWithPosition = folding $ (<>) <$> backpackItems <*> handItems where backpackItems = toListOf $ backpack . folded . to (Backpack ,) handItems inv = case inv ^. wielded of - DoubleHanded i -> pure (BothHands, i ^. wieldedItem) - Hands l r -> (l ^.. folded . wieldedItem . to (LeftHand ,)) - <> (r ^.. folded . wieldedItem . to (RightHand ,)) + DoubleHanded i -> pure (InHand BothHands, i ^. wieldedItem) + Hands l r -> (l ^.. folded . wieldedItem . to (InHand LeftHand ,)) + <> (r ^.. folded . wieldedItem . to (InHand RightHand ,)) -- | Remove the first item equal to 'Item' from the given position in the -- inventory removeItemFromPosition :: InventoryPosition -> Item -> Inventory -> Inventory removeItemFromPosition Backpack item inv = inv & backpack %~ removeFirst (== item) -removeItemFromPosition LeftHand item inv +removeItemFromPosition (InHand LeftHand) item inv = inv & wielded . leftHand %~ filter ((/= item) . view wieldedItem) -removeItemFromPosition RightHand item inv +removeItemFromPosition (InHand RightHand) item inv = inv & wielded . rightHand %~ filter ((/= item) . view wieldedItem) -removeItemFromPosition BothHands item inv +removeItemFromPosition (InHand BothHands) item inv | has (wielded . doubleHanded . wieldedItem . filtered (== item)) inv = inv & wielded .~ nothingWielded | otherwise diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml index 62cb033d0..bc08ec1ad 100644 --- a/users/grfn/xanthous/src/Xanthous/messages.yaml +++ b/users/grfn/xanthous/src/Xanthous/messages.yaml @@ -115,8 +115,8 @@ wield: - You can't wield anything in your backpack - You can't wield anything currently in your backpack menu: What would you like to wield? - # TODO: use actual hands - wielded : You wield the {{wieldedItem.itemType.name}} in your right hand. + hand: Wield in which hand? + wielded: You wield the {{item.wieldedItem.itemType.name}} in {{hand}} fire: nothing: diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs index ba27e3cbc..a6f8401cf 100644 --- a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs +++ b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs @@ -10,6 +10,17 @@ import Xanthous.Entities.Common main :: IO () main = defaultMain test +newtype OneHand = OneHand Hand + deriving stock Show + +instance Arbitrary OneHand where + arbitrary = OneHand <$> elements [LeftHand, RightHand] + +otherHand :: Hand -> Hand +otherHand LeftHand = RightHand +otherHand RightHand = LeftHand +otherHand BothHands = error "OtherHand BothHands" + test :: TestTree test = testGroup "Xanthous.Entities.CommonSpec" [ testGroup "Inventory" @@ -20,13 +31,35 @@ test = testGroup "Xanthous.Entities.CommonSpec" let (old, inv') = inv & wielded <<.~ w in inv' & backpack <>~ toVectorOf (wieldedItems . wieldedItem) old in [ (Backpack, \item -> backpack %~ (item ^. wieldedItem <|)) - , (LeftHand, rewield . inLeftHand) - , (RightHand, rewield . inRightHand) - , (BothHands, rewield . review doubleHanded) + , (InHand LeftHand, rewield . inLeftHand) + , (InHand RightHand, rewield . inRightHand) + , (InHand BothHands, rewield . review doubleHanded) ] <&> \(pos, addItem) -> testProperty (show pos) $ \inv item -> let inv' = addItem item inv inv'' = removeItemFromPosition pos (item ^. wieldedItem) inv' in inv'' ^.. items === inv ^.. items ] + , testGroup "Wielded items" + [ testGroup "wieldInHand" + [ testProperty "puts the item in the hand" $ \w hand item -> + let (_, w') = wieldInHand hand item w + in itemsInHand hand w' === [item] + , testProperty "returns items in both hands when wielding double-handed" + $ \lh rh newItem -> + let w = Hands (Just lh) (Just rh) + (prevItems, _) = wieldInHand BothHands newItem w + in prevItems === [lh, rh] + , testProperty "wielding in one hand leaves the item in the other hand" + $ \(OneHand h) existingItem newItem -> + let (_, w) = wieldInHand h existingItem nothingWielded + (prevItems, w') = wieldInHand (otherHand h) newItem w + in prevItems === [] + .&&. sort (w' ^.. wieldedItems) === sort [existingItem, newItem] + , testProperty "always leaves the same items overall" $ \w hand item -> + let (prevItems, w') = wieldInHand hand item w + in sort (prevItems <> (w' ^.. wieldedItems)) + === sort (item : w ^.. wieldedItems) + ] + ] ]