Simplify right button options

2023-05-15 11:06:13 +01:00
parent 0735b46266
commit a67e8667bc
4 changed files with 29 additions and 152 deletions
@@ -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 rbops invid cr w = case rbops ^? opAllocateEquipment of
-    Just DoNotMoveEquipment -> w
-    Just PutOnEquipment{_allocNewPos = newp} ->
+toggleEquipmentAt :: Int -> Creature -> World -> World
+toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
+    DoNotMoveEquipment -> w
+    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
@@ -15,20 +15,11 @@ data RightButtonOptions
    | EquipOptions
        { _opEquip :: [EquipPosition]
        , _opSel :: Int
-        , _opItemID :: Int
-        , _opAllocateEquipment :: AllocateEquipment
-        , _opActivateEquipment :: ModifyEquipmentActivation
+        , _opAllocateEquipment :: EquipmentAllocation
        }
    --deriving (Eq, Ord, Show, Read) --Generic, Flat)

-data ModifyEquipmentActivation
-    = ActivateEquipment {_activateEquipment :: Int}
-    | DeactivateEquipment {_deactivateEquipment :: Int}
-    | ActivateDeactivateEquipment {_activateEquipment :: Int, _deactivateEquipment :: Int}
-    | NoChangeActivateEquipment
-    --deriving (Eq, Ord, Show, Read) --Generic, Flat)
-
-data AllocateEquipment
+data EquipmentAllocation
    = DoNotMoveEquipment
    | PutOnEquipment
        { _allocNewPos :: EquipPosition
@@ -52,8 +43,6 @@ data AllocateEquipment
    --deriving (Eq, Ord, Show, Read) --Generic, Flat)

 makeLenses ''RightButtonOptions
-makeLenses ''AllocateEquipment
-makeLenses ''ModifyEquipmentActivation
-deriveJSON defaultOptions ''ModifyEquipmentActivation
-deriveJSON defaultOptions ''AllocateEquipment
+makeLenses ''EquipmentAllocation
+deriveJSON defaultOptions ''EquipmentAllocation
 deriveJSON defaultOptions ''RightButtonOptions
@@ -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
@@ -1,14 +1,14 @@
-module Dodge.Inventory.Add 
-    ( tryPutItemInInv
-    , createPutItem
-    , createAndSelectItem
-    )where
+module Dodge.Inventory.Add (
+    tryPutItemInInv,
+    createPutItem,
+    createAndSelectItem,
+) 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
-    (i, w') <- tryPutItemInInv cid (w ^?! cWorld . lWorld . floorItems . ix flid) w
+    flit <- w ^? cWorld . lWorld . floorItems . ix flid
+    (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' 
-        & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0,i)
-        & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
-            .~ InInventory (SelItem i NoInvSelAction)
+    (Just i, w') ->
+        w'
+            & hud . hudElement . diSections . sssExtra . sssSelPos ?~ (0, i)
+            & cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
+                .~ InInventory (SelItem i NoInvSelAction)
    (Nothing, w') -> w'

 createPutItem :: Item -> World -> (Maybe Int, World)