Add file

src/Dodge/Inventory/RBList.hs

@@ -0,0 +1,80 @@
+module Dodge.Inventory.RBList (
+    updateRBList,
+    getEquipmentAllocation,
+) where
+
+import Control.Lens
+import Data.List (elemIndex, findIndex)
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import Dodge.Base.You
+import Dodge.Data.World
+import qualified SDL
+
+updateRBList :: World -> World
+updateRBList w
+    | not (SDL.ButtonRight `M.member` (w ^. input . mouseButtons)) =
+        w & rbOptions .~ NoRightButtonOptions
+    | otherwise = case w ^. rbOptions of
+        EquipOptions{} -> w & rbOptions . opAllocateEquipment .~ (getEquipmentAllocation w)
+        _ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
+            i <- cr ^? crManipulation . manObject . inInventory . ispItem
+            esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
+            return $
+                w
+                    & rbOptions
+                        .~ EquipOptions
+                            { _opEquip = equipSiteToPositions esite
+                            , _opSel = chooseEquipmentPosition cr (equipSiteToPositions esite)
+                            , _opAllocateEquipment = DoNotMoveEquipment
+                            }
+                    & rbOptions . opAllocateEquipment .~ (getEquipmentAllocation w)
+  where
+    cr = you w
+
+getEquipmentAllocation :: World -> EquipmentAllocation
+getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do
+    curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
+    i <- w ^? rbOptions . opSel
+    es <- w ^? rbOptions . opEquip . ix i
+    return $ case you w ^? crInvEquipped . ix curpos of
+        Just epos
+            | es == epos -> RemoveEquipment{_allocOldPos = epos}
+        Just epos
+            | isJust (you w ^? crEquipment . ix es) ->
+                SwapEquipment
+                    { _allocOldPos = epos
+                    , _allocNewPos = es
+                    , _allocSwapID = _crEquipment (you w) M.! es
+                    }
+        Just epos ->
+            MoveEquipment
+                { _allocOldPos = epos
+                , _allocNewPos = es
+                }
+        Nothing
+            | isJust (you w ^? crEquipment . ix es) ->
+                ReplaceEquipment
+                    { _allocNewPos = es
+                    , _allocRemoveID = _crEquipment (you w) M.! es
+                    }
+        Nothing -> PutOnEquipment{_allocNewPos = es}
+
+equipSiteToPositions :: EquipSite -> [EquipPosition]
+equipSiteToPositions es = case es of
+    GoesOnHead -> [OnHead]
+    GoesOnChest -> [OnChest]
+    GoesOnBack -> [OnBack]
+    GoesOnWrist -> [OnLeftWrist, OnRightWrist]
+    GoesOnLegs -> [OnLegs]
+
+chooseEquipmentPosition :: Creature -> [EquipPosition] -> Int
+chooseEquipmentPosition cr eps = fromMaybe (chooseFreeSite cr eps) $ do
+    i <- cr ^? crManipulation . manObject . inInventory . ispItem
+    ep <- cr ^? crInvEquipped . ix i
+    elemIndex ep eps
+
+chooseFreeSite :: Creature -> [EquipPosition] -> Int
+chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
+  where
+    hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep