Allow for separate equipment positions on body

src/Dodge/Combine/Data.hs

@@ -78,6 +78,9 @@ data CombineType
     | MAGSHIELD
     | FLAMESHIELD
     | FRONTARMOUR
+    | POWERLEGS
+    | SPEEDLEGS
+    | JUMPLEGS
     | FLATSHIELD
     | JETPACK
     -- Crafting

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

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

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

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

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 %~ IM.delete invid
-        & creatures . ix cid . crInvEquipped %~ IS.map g
+        & 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

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"
+    }

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
+        Just invid -> f' cyan invid
-    equipcursors = foldMap (f yellow) (IS.toList $ _crInvEquipped cr)
+    equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
-    f col invid = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text "EQUIPPED"
+    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