From 8ad332aceda514814ba632e3dceb468f36561949 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 21 May 2022 14:41:49 +0100 Subject: [PATCH] Allow for separate equipment positions on body --- src/Dodge/Combine/Data.hs | 3 +++ src/Dodge/Creature.hs | 3 +++ src/Dodge/Creature/Impulse/UseItem.hs | 14 ++++++++++++-- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Data.hs | 11 ++++++++++- src/Dodge/Inventory.hs | 7 ++++--- src/Dodge/Item/Equipment.hs | 22 ++++++++++++++++++++++ src/Dodge/Render/HUD.hs | 17 ++++++++++++++--- 8 files changed, 69 insertions(+), 10 deletions(-) diff --git a/src/Dodge/Combine/Data.hs b/src/Dodge/Combine/Data.hs index 78ae90f6b..e8a72c6e2 100644 --- a/src/Dodge/Combine/Data.hs +++ b/src/Dodge/Combine/Data.hs @@ -78,6 +78,9 @@ data CombineType | MAGSHIELD | FLAMESHIELD | FRONTARMOUR + | POWERLEGS + | SPEEDLEGS + | JUMPLEGS | FLATSHIELD | JETPACK -- Crafting diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index ddf149ca3..00051c056 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -176,6 +176,9 @@ testInventory = IM.fromList $ zip [0..] [ makeTypeCraftNum 9 PIPE , frontArmour , flameShield + , powerLegs + , speedLegs + , jumpLegs , makeModule INCENDIARYMODULE , makeModule STATICMODULE , makeModule CONCUSSMODULE diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index d1505c9da..597fe9b07 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -42,17 +42,27 @@ itemEffect cr it w = case it ^? itUse of toggleEquipmentAt :: Int -> Item -> Creature -> Creature toggleEquipmentAt invid itm cr - | invid `IS.member` _crInvEquipped cr = cr & crInvEquipped . at invid .~ Nothing + | invid `IM.member` _crInvEquipped cr = cr & crInvEquipped . at invid .~ Nothing & removeEquipmentUsingSite esite & setEquipmentSite esite Nothing' - | otherwise = cr & crInvEquipped . at invid .~ Just () + | otherwise = cr & crInvEquipped . at invid .~ Just epos & removeEquipmentUsingSite esite & setEquipmentSite esite (Just' invid) where esite = _eqSite (_itUse itm) + epos = eqSiteToPos cr esite f Nothing = Just () f (Just ()) = Nothing +eqSiteToPos :: Creature -> EquipSite -> EquipPosition +eqSiteToPos cr es = case es of + GoesOnHead -> OnHead + GoesOnChest -> OnChest + GoesOnBack -> OnBack + GoesOnWrist -> OnLeftWrist + GoesOnLegs -> OnLegs + GoesOnSpecial -> OnSpecial + removeEquipmentUsingSite :: EquipSite -> Creature -> Creature removeEquipmentUsingSite esite cr = case esite of GoesOnSpecial -> cr diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 78a750c72..16a55779c 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -153,7 +153,7 @@ useEquipment cr i = _eqUse (_itUse $ _crInv cr IM.! i) cr i invSideEff :: Creature -> World -> World invSideEff cr w = weaponReloadSounds cr - . flip (IS.foldr $ useEquipment cr) (_crInvEquipped cr) + . flip (foldr $ useEquipment cr) (IM.keys $ _crInvEquipped cr) $ IM.foldrWithKey f w (_crInv cr) where f i it w' = doitemupdate w' & case it ^? itEffect . itInvEffect of diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index dc19be2b9..24036c8cd 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -277,7 +277,7 @@ data Creature = Creature , _crInvSel :: Int , _crInvCapacity :: Int , _crInvLock :: Bool - , _crInvEquipped :: IS.IntSet + , _crInvEquipped :: IM.IntMap EquipPosition , _crEquipment :: CreatureEquipment , _crLeftInvSel :: Maybe Int , _crState :: CreatureState @@ -396,6 +396,15 @@ data EquipSite | GoesOnLegs | GoesOnSpecial deriving (Eq,Ord,Show) +data EquipPosition + = OnHead + | OnChest + | OnBack + | OnLeftWrist + | OnRightWrist + | OnLegs + | OnSpecial + deriving (Eq,Ord,Show) _itUseAimStance :: Item -> AimStance _itUseAimStance = _aimStance . _useAim . _itUse data ItemConsumption diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index fe95466f9..abd5dd719 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -51,8 +51,9 @@ rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itCons _ -> w & creatures . ix cid . crInv %~ f & creatures . ix cid . crInvSel %~ g & creatures . ix cid . crLeftInvSel . _Just %~ g - & creatures . ix cid . crInvEquipped %~ IS.delete invid - & creatures . ix cid . crInvEquipped %~ IS.map g + & creatures . ix cid . crInvEquipped %~ IM.delete invid + & creatures . ix cid . crInvEquipped %~ IM.mapKeys g + -- TODO check whether this can be mapKeysMonotonic where maxk = fmap fst $ IM.lookupMax $ _crInv $ _creatures w IM.! cid f inv = let (xs,ys) = IM.split invid inv @@ -186,7 +187,7 @@ changeSwapInvSel k w updatecreature = ( crInv %~ IM.swapKeys (i `mod` n) swapi ) . (crLeftInvSel . _Just %~ updateLeftInvSel) . (crInvSel %~ (`mod` n) . subtract k) - . (crInvEquipped %~ swapIntSetKeys i swapi) + . (crInvEquipped %~ IM.swapKeys i swapi) swapi = (i - k) `mod` n updateLeftInvSel li | i == li = swapi | swapi == li = i diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 52cc21fe1..11e75df2f 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -182,3 +182,25 @@ jetPack = defaultEquipment , _itEffect = NoItEffect , _itID = Nothing } + +powerLegs :: Item +powerLegs = defaultEquipment + { _itType = POWERLEGS + , _itName = "POWERLEGS" + , _itUse = EquipUse + {_eqUse = \_ _ -> id + ,_eqSite = GoesOnLegs + } + , _itEffect = NoItEffect + , _itID = Nothing + } +speedLegs :: Item +speedLegs = powerLegs + { _itType = SPEEDLEGS + , _itName = "SPEEDLEGS" + } +jumpLegs :: Item +jumpLegs = powerLegs + { _itType = JUMPLEGS + , _itName = "JUMPLEGS" + } diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index bf2877bda..6a5244347 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -127,9 +127,20 @@ subInventoryDisplay subinv cfig w = case subinv of cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w) equipcursor = case _crLeftInvSel cr of Nothing -> mempty - Just invid -> f cyan invid - equipcursors = foldMap (f yellow) (IS.toList $ _crInvEquipped cr) - f col invid = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text "EQUIPPED" + Just invid -> f' cyan invid + equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr) + f' col invid = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text "EQUIPPED" + f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos + +eqPosText :: EquipPosition -> String +eqPosText ep = case ep of + OnHead -> "HEAD" + OnChest -> "CHEST" + OnBack -> "BACK" + OnLeftWrist -> "L-WRIST" + OnRightWrist -> "R-WRIST" + OnLegs -> "LEGS" + OnSpecial -> "EQUIPPED" topInvW :: Int topInvW = 15