Simplify right button options

src/Dodge/Creature/Impulse/UseItem.hs

@@ -5,6 +5,7 @@ module Dodge.Creature.Impulse.UseItem (
     useItemHotkey,
 ) where
 
+import Dodge.Inventory.RBList
 import Dodge.Hotkey
 import Control.Lens
 import Control.Monad
@@ -51,7 +52,7 @@ itemEffect cr it w = case it ^. itUse of
     doequipmentchange =
         setuhamdown $
             hammerTest
-                ( toggleEquipmentAt (_rbOptions w) itRef cr
+                ( toggleEquipmentAt itRef cr
                 )
 
 tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World
@@ -69,27 +70,27 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
   where
     ic = _heldConsumption (_itUse it)
 
-toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
+toggleEquipmentAt :: Int -> Creature -> World -> World
-toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
+toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
-    Just DoNotMoveEquipment -> w
+    DoNotMoveEquipment -> w
-    Just PutOnEquipment{_allocNewPos = newp} ->
+    PutOnEquipment{_allocNewPos = newp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInvEquipped . at invid ?~ newp
             & onequip itm cr
             & crpoint %~ assignNewHotkey invid
-    Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
+    MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid ?~ newp
-    Just SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
+    SwapEquipment{_allocNewPos = newp, _allocOldPos = oldp, _allocSwapID = sid} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crEquipment . at oldp ?~ sid
             & crpoint . crInvEquipped . at invid ?~ newp
             & crpoint . crInvEquipped . at sid ?~ oldp
-    Just ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
+    ReplaceEquipment{_allocNewPos = newp, _allocRemoveID = rid} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInvEquipped . at invid ?~ newp
@@ -98,13 +99,12 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
             & onequip itm cr
             & crpoint %~ removeHotkey rid
             & crpoint %~ assignNewHotkey invid
-    Just RemoveEquipment{_allocOldPos = oldp} ->
+    RemoveEquipment{_allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid .~ Nothing
             & onremove itm cr
             & crpoint %~ removeHotkey invid
-    Nothing -> error "tried to toggle equipment when not prepared"
   where
     crpoint = cWorld . lWorld . creatures . ix (_crID cr)
     itmat i = _crInv cr IM.! i

src/Dodge/Data/RightButtonOptions.hs

@@ -15,20 +15,11 @@ data RightButtonOptions
     | EquipOptions
         { _opEquip :: [EquipPosition]
         , _opSel :: Int
-        , _opItemID :: Int
+        , _opAllocateEquipment :: EquipmentAllocation
-        , _opAllocateEquipment :: AllocateEquipment
-        , _opActivateEquipment :: ModifyEquipmentActivation
         }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data ModifyEquipmentActivation
+data EquipmentAllocation
-    = ActivateEquipment {_activateEquipment :: Int}
-    | DeactivateEquipment {_deactivateEquipment :: Int}
-    | ActivateDeactivateEquipment {_activateEquipment :: Int, _deactivateEquipment :: Int}
-    | NoChangeActivateEquipment
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-data AllocateEquipment
     = DoNotMoveEquipment
     | PutOnEquipment
         { _allocNewPos :: EquipPosition
@@ -52,8 +43,6 @@ data AllocateEquipment
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''RightButtonOptions
-makeLenses ''AllocateEquipment
+makeLenses ''EquipmentAllocation
-makeLenses ''ModifyEquipmentActivation
+deriveJSON defaultOptions ''EquipmentAllocation
-deriveJSON defaultOptions ''ModifyEquipmentActivation
-deriveJSON defaultOptions ''AllocateEquipment
 deriveJSON defaultOptions ''RightButtonOptions

src/Dodge/Inventory.hs

@@ -4,7 +4,6 @@ module Dodge.Inventory (
     rmSelectedInvItem,
     rmInvItem,
     updateCloseObjects,
-    updateRBList,
     closeObjScrollDir,
     changeSwapSel,
     scrollAugInvSel,
@@ -12,10 +11,11 @@ module Dodge.Inventory (
     crInvSize,
     selectedCloseObject,
     setInvPosFromSS,
+    module Dodge.Inventory.RBList
 ) where
 
+import Dodge.Inventory.RBList
 import Control.Applicative
-import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base
 import Dodge.Data.SelectionList
@@ -133,119 +133,6 @@ updateCloseObjects w =
     updatebyid (Left flid) = fmap Left $ w ^? cWorld . lWorld . floorItems . ix (_flItID flid)
     updatebyid (Right btid) = fmap Right $ w ^? cWorld . lWorld . buttons . ix (_btID btid)
 
-updateRBList :: World -> World
-updateRBList w
-    | w ^? rbOptions . opItemID == mcurrentitemid =
-        w & setEquipAllocation
-    | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
-        i <- cr ^? crManipulation . manObject . inInventory . ispItem
-        esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
-        itid <- mcurrentitemid
-        return $
-            w
-                & rbOptions
-                    .~ EquipOptions
-                        { _opEquip = equipSiteToPositions esite
-                        , _opSel = chooseEquipmentPosition cr (equipSiteToPositions esite)
-                        , _opItemID = itid
-                        , _opAllocateEquipment = DoNotMoveEquipment
-                        , _opActivateEquipment = NoChangeActivateEquipment
-                        }
-                & setEquipAllocation
-  where
-    mcurrentitemid = do
-        i <- cr ^? crManipulation . manObject . inInventory . ispItem
-        cr ^? crInv . ix i . itID
-    cr = you w
-
-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
-
-setEquipAllocation :: World -> World
-setEquipAllocation w = fromMaybe w $ do
-    curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
-    i <- w ^? rbOptions . opSel
-    es <- w ^? rbOptions . opEquip . ix i
-    return $
-        w & rbOptions . opAllocateEquipment .~ 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}
-
---setEquipActivation :: World -> World
---setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
---    Just DoNotMoveEquipment -> w
---    Just RemoveEquipment{} ->
---        case you w ^. crLeftInvSel . lisMPos of
---            Just i
---                | Just i == minvsel ->
---                    w & rbOptions . opActivateEquipment
---                        .~ DeactivateEquipment
---                            { _deactivateEquipment = i
---                            }
---            _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
---    Just rbos ->
---        case you w ^. crLeftInvSel . lisMPos of
---            Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
---            Just i
---                | invselcanactivate ->
---                    w & rbOptions . opActivateEquipment
---                        .~ ActivateDeactivateEquipment
---                            { _activateEquipment = fromJust minvsel
---                            , _deactivateEquipment = i
---                            }
---            Just i
---                | Just i == rbos ^? allocRemoveID ->
---                    w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
---            Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
---            Nothing
---                | invselcanactivate ->
---                    w & rbOptions . opActivateEquipment
---                        .~ ActivateEquipment
---                            { _activateEquipment = fromJust minvsel
---                            }
---            Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
---    Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
---  where
---    minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
---    cr = you w
---    invselcanactivate = isJust $ do
---        i <- minvsel
---        return $ cr ^? crInv . ix i . itUse . leftUse
-
-equipSiteToPositions :: EquipSite -> [EquipPosition]
-equipSiteToPositions es = case es of
-    GoesOnHead -> [OnHead]
-    GoesOnChest -> [OnChest]
-    GoesOnBack -> [OnBack]
-    GoesOnWrist -> [OnLeftWrist, OnRightWrist]
-    GoesOnLegs -> [OnLegs]
 
 closeObjScrollDir :: Float -> World -> World
 closeObjScrollDir x

src/Dodge/Inventory/Add.hs

@@ -1,14 +1,14 @@
-module Dodge.Inventory.Add 
+module Dodge.Inventory.Add (
-    ( tryPutItemInInv
+    tryPutItemInInv,
-    , createPutItem
+    createPutItem,
-    , createAndSelectItem
+    createAndSelectItem,
-    )where
+) where
 
-import Dodge.Data.SelectionList
 import Control.Lens
 import Data.Maybe
 import Dodge.Base.You
 import Dodge.Combine.Module
+import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.FloorItem
 import Dodge.Inventory.CheckSlots
@@ -16,8 +16,8 @@ import qualified IntMapHelp as IM
 
 putItemInInvID :: Int -> Int -> World -> (Maybe Int, World)
 putItemInInvID cid flid w = fromMaybe (Nothing, w) $ do
-    --(i, w') <- tryPutItemInInv cid (_floorItems (_cWorld w) IM.! flid) w
+    flit <- w ^? cWorld . lWorld . floorItems . ix flid
-    (i, w') <- tryPutItemInInv cid (w ^?! cWorld . lWorld . floorItems . ix flid) w
+    (i, w') <- tryPutItemInInv cid flit w
     return (Just i, w')
 
 putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item
@@ -42,10 +42,11 @@ tryPutItemInInv cid flit w = case maybeInvSlot of
 
 createAndSelectItem :: Item -> World -> World
 createAndSelectItem itm w = case createPutItem itm w of
-    (Just i, w') -> w' 
+    (Just i, w') ->
-        & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0,i)
+        w'
-        & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
+            & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
-            .~ InInventory (SelItem i NoInvSelAction)
+            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
+                .~ InInventory (SelItem i NoInvSelAction)
     (Nothing, w') -> w'
 
 createPutItem :: Item -> World -> (Maybe Int, World)