From a67e8667bca3db2e92d4f6f0e87223f5254d2d42 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 15 May 2023 11:06:13 +0100 Subject: [PATCH] Simplify right button options --- src/Dodge/Creature/Impulse/UseItem.hs | 20 ++--- src/Dodge/Data/RightButtonOptions.hs | 19 +---- src/Dodge/Inventory.hs | 117 +------------------------- src/Dodge/Inventory/Add.hs | 25 +++--- 4 files changed, 29 insertions(+), 152 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 5a106bc0d..98433f090 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/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 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 diff --git a/src/Dodge/Data/RightButtonOptions.hs b/src/Dodge/Data/RightButtonOptions.hs index 3a26869cc..6f4629b62 100644 --- a/src/Dodge/Data/RightButtonOptions.hs +++ b/src/Dodge/Data/RightButtonOptions.hs @@ -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 diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index f0ea63b11..e6b438668 100644 --- a/src/Dodge/Inventory.hs +++ b/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 diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index f712b480b..2e0cb1499 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -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)