Fix bugs in equipment allocation using hotkeys

The behaviour is still not perfect, should be able to cycle through all
options by pressing one key. There is unnecessary memory of past state
going on here
This commit is contained in:
2025-01-01 14:48:17 +00:00
parent 7dd379d4bc
commit dae0e0591c
10 changed files with 289 additions and 313 deletions
+1 -1
View File
File diff suppressed because one or more lines are too long
+3 -3
View File
@@ -81,7 +81,7 @@ activateDetonator det = fromMaybe id $ do
return $ cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 0
toggleEquipmentAt :: Int -> Creature -> World -> World
toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
toggleEquipmentAt invid cr w = case getEquipmentAllocation invid w of
DoNotMoveEquipment -> w
PutOnEquipment{_allocNewPos = newp} ->
w
@@ -114,7 +114,7 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
where
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
itm = itmat itRef
itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change?
itm = itmat invid
-- itRef = cr ^?! crManipulation . manObject . imSelectedItem -- unsafe!! TODO change?
onequip itm' = doItmCrWdWd ((_eeOnEquip . _uequipEffect . _itUse) itm') itm'
onremove itm' = doItmCrWdWd ((_eeOnRemove . _uequipEffect . _itUse) itm') itm'
+1 -1
View File
@@ -60,7 +60,7 @@ data Button = Button
--deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat)
data ButtonState = BtOn | BtOff | BtNoLabel
data ButtonState = BtOn | BtOff | BtInactive
deriving Eq -- (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Button
+1 -1
View File
@@ -53,7 +53,7 @@ defaultButton =
{ _btPict = DefaultDrawButton (dark red)
, _btPos = V2 0 0
, _btRot = 0
, _btEvent = ButtonPress BtNoLabel ButtonDoNothing click1S NoWorldEffect
, _btEvent = ButtonPress BtInactive ButtonDoNothing click1S NoWorldEffect
, _btID = 0
, _btText = "Button"
, _btState = BtOff
+2 -20
View File
@@ -7,7 +7,6 @@ module Dodge.Inventory (
augInvDirectSelect,
scrollAugInvSel,
crNumFreeSlots,
crInvSize,
setInvPosFromSS,
module Dodge.Inventory.RBList,
swapInvItems,
@@ -72,10 +71,6 @@ rmInvItem cid invid w =
& pointcid . crInv %~ f -- important
& removeAnySlotEquipment
& pointcid . crEquipment . each %~ g
-- & removeanyactivation
-- & cWorld . lWorld . hotkeys . each %~ g
-- & cWorld . lWorld . imHotkeys %~ IM.delete invid
-- & cWorld . lWorld . imHotkeys %~ IM.mapKeys g
& updateselection
& updateselectionextra
& pointcid %~ updateRootItemID
@@ -87,7 +82,7 @@ rmInvItem cid invid w =
| otherwise = id
updateselection
| cid == 0 && cr ^? crManipulation . manObject . imSelectedItem == Just invid =
scrollAugInvSel (-1) . scrollAugInvSel 1 -- . updateInventorySectionItems
scrollAugInvSel (-1) . scrollAugInvSel 1
| otherwise =
pointcid . crManipulation . manObject . imSelectedItem %~ g
cr = w ^?! cWorld . lWorld . creatures . ix cid
@@ -102,9 +97,6 @@ rmInvItem cid invid w =
epos <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
. itLocation . ilEquipSite . _Just
return $ pointcid . crEquipment . at epos .~ Nothing
-- removeanyactivation = fromMaybe id $ do
-- epos <- w ^? cWorld . lWorld . imHotkeys . ix invid
-- return $ cWorld . lWorld . hotkeys . at epos .~ Nothing
maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
f inv =
let (xs, ys) = IM.split invid inv
@@ -132,21 +124,12 @@ updateCloseObjects w =
isclose pos = dist ypos pos < 40 && hasButtonLOS ypos pos w
ypos = _crPos $ you w
activeButtons =
filter ((/=) BtNoLabel . _btState)
filter ((/=) BtInactive . _btState)
. IM.elems
$ w ^. cWorld . lWorld . buttons
-- updatecursorposifnecessary =
-- case w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . ispCloseObject of
-- Just i
-- | i >= length newcloseobjects -> scrollAugInvSel 1
-- | isNothing (w ^? hud . hudElement . diSections . ix 3 . ssItems . ix i) ->
-- scrollAugInvSel (-1)
-- _ -> id
changeSwapSel :: Int -> World -> World
changeSwapSel yi w
-- | yi == 0 = w
| yi >= 0 = foldl' (&) w $ replicate yi (changeSwapWith $ f IM.cycleLT)
| otherwise = foldl' (&) w $ replicate (negate yi) (changeSwapWith $ f IM.cycleGT)
where
@@ -175,7 +158,6 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
& hud . hudElement . diSelection . _Just . _2 %~ doswap
& worldEventFlags . at InventoryChange ?~ ()
swapItemWith ::
(Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
(Int, Int) ->
+5 -12
View File
@@ -1,13 +1,12 @@
module Dodge.Inventory.CheckSlots (
checkInvSlotsYou,
crNumFreeSlots,
crInvSize,
) where
import Control.Monad
import Dodge.Item.InvSize
import Control.Lens
import Data.Monoid
import Dodge.Base.You
import Dodge.Data.World
import qualified IntMapHelp as IM
@@ -15,19 +14,13 @@ import qualified IntMapHelp as IM
if so return Just the next slot to be used
-}
checkInvSlotsYou :: Item -> World -> Maybe Int
checkInvSlotsYou it w
| crNumFreeSlots ycr >= itInvHeight it =
Just . IM.newKey $ _crInv ycr
| otherwise = Nothing
where
ycr = you w
checkInvSlotsYou it w = do
ycr <- w ^? cWorld . lWorld . creatures . ix 0
guard $ crNumFreeSlots ycr >= itInvHeight it
Just . IM.newKey $ _crInv ycr
crNumFreeSlots :: Creature -> Int
crNumFreeSlots cr = _crInvCapacity cr - invSize (_crInv cr)
crInvSize :: Creature -> Int
crInvSize = invSize . _crInv
invSize :: IM.IntMap Item -> Int
invSize = alaf Sum foldMap itInvHeight
--invSize = sum . fmap _itInvSize
+5 -5
View File
@@ -42,15 +42,15 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
where
hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
getEquipmentAllocation :: World -> EquipmentAllocation
getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do
curpos <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix curpos . itUse . uequipEffect . eeType
getEquipmentAllocation :: Int -> World -> EquipmentAllocation
getEquipmentAllocation invid w = fromMaybe DoNotMoveEquipment $ do
-- curpos <- you w ^? crManipulation . manObject . imSelectedItem
esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeType
i <-
w ^? rbOptions . opSel
<|> Just (chooseEquipPosition (you w) (eqSiteToPositions esite))
es <- eqSiteToPositions esite ^? ix i
return $ case you w ^? crInv . ix curpos . itLocation . ilEquipSite . _Just of
return $ case you w ^? crInv . ix invid . itLocation . ilEquipSite . _Just of
Just epos
| es == epos -> RemoveEquipment{_allocOldPos = epos}
Just epos
+1 -1
View File
@@ -19,7 +19,7 @@ makeButton
-> Button
makeButton col eff = defaultButton
{ _btPict = DefaultDrawButton col
, _btEvent = ButtonPress BtNoLabel ButtonDoNothing click1S eff
, _btEvent = ButtonPress BtInactive ButtonDoNothing click1S eff
, _btText = "Button"
, _btState = BtOff
}
+1 -1
View File
@@ -242,7 +242,7 @@ drawRBOptions cfig w = fromMaybe mempty $ do
fmap eqSiteToPositions $
you w ^? crInv . ix invid . itUse . uequipEffect . eeType
i <- w ^? rbOptions . opSel
let ae = getEquipmentAllocation w
let ae = getEquipmentAllocation invid w
sss <- w ^? hud . hudElement . diSections
(i', j, _) <- w ^? hud . hudElement . diSelection . _Just
curpos <- selSecYint i' j sss
+269 -268
View File
File diff suppressed because it is too large Load Diff