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:
File diff suppressed because one or more lines are too long
@@ -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'
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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) ->
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user