Allow fast drop and pickup, fix right button options bug

This commit is contained in:
2023-01-13 16:32:42 +00:00
parent 5f871264d4
commit 6f1162f7b9
4 changed files with 24 additions and 20 deletions
+7 -10
View File
@@ -144,7 +144,6 @@ performAction cr w ac = case ac of
(imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac)
NoAction -> ([], Nothing)
setMinInvSize :: Int -> Creature -> World -> World
setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
@@ -162,7 +161,7 @@ organiseInvKeys cid w =
. (crInvSel . iselAction .~ NoInvSelAction)
)
where
cr = w ^?! cWorld . lWorld . creatures . ix cid-- _creatures (_cWorld w) IM.! cid
cr = w ^?! cWorld . lWorld . creatures . ix cid -- _creatures (_cWorld w) IM.! cid
pairs = IM.toList (_crInv cr)
newSelKey = fromMaybe 0 $ findIndex ((== crSel cr) . fst) pairs
newInv = IM.fromAscList $ zip [0 ..] $ map snd pairs
@@ -187,21 +186,19 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . maybe
-- Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
-- _ -> id
-- | Get your creature to drop the item under the cursor.
youDropItem :: World -> World
youDropItem w
| _crInvLock (you w) = w
| otherwise = youDropItem' w
-- | Get your creature to drop the item under the cursor.
youDropItem' :: World -> World
youDropItem' w = case yourItem w ^? _Just . itCurseStatus of
Just Uncursed ->
| _crInvLock (you w) || cursed = w
| otherwise =
w
& dropItem cr (crSel cr)
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
_ -> w
where
cr = you w
cursed = fromMaybe True $ do
it <- yourItem w
return $ it ^. itCurseStatus /= Uncursed
-- | Copy an inventory item to the floor.
copyInvItemToFloor :: Creature -> Int -> World -> World
+1 -1
View File
@@ -15,7 +15,7 @@ data RightButtonOptions
| EquipOptions
{ _opEquip :: [EquipPosition]
, _opSel :: Int
, _opCurInvPos :: Int
, _opItemID :: Int
, _opAllocateEquipment :: AllocateEquipment
, _opActivateEquipment :: ActivateEquipment
}
+12 -9
View File
@@ -185,22 +185,25 @@ updateCloseObjects w =
updateRBList :: World -> World
updateRBList w
| w ^? rbOptions . opCurInvPos == Just curinvid =
| w ^? rbOptions . opItemID == mcurrentitemid =
w & setEquipAllocation & setEquipActivation
| otherwise = case cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite of
Just esite ->
| otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
esite <- cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite
itid <- mcurrentitemid
return $
w
& rbOptions
.~ EquipOptions
(equipSiteToPositions esite)
(chooseEquipmentPosition cr (equipSiteToPositions esite))
curinvid
DoNotMoveEquipment
NoChangeActivateEquipment
{ _opEquip = (equipSiteToPositions esite)
, _opSel = (chooseEquipmentPosition cr (equipSiteToPositions esite))
, _opItemID = itid
, _opAllocateEquipment = DoNotMoveEquipment
, _opActivateEquipment = NoChangeActivateEquipment
}
& setEquipAllocation
& setEquipActivation
Nothing -> w & rbOptions .~ NoRightButtonOptions
where
mcurrentitemid = cr ^? crInv . ix curinvid . itID
curinvid = crSel cr
cr = you w
+4
View File
@@ -80,6 +80,10 @@ updateKeyInGame uv sc InitialPress = case sc of
ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv
_ -> uv
updateKeyInGame uv sc LongPress = case sc of
ScancodeF -> over uvWorld youDropItem uv
ScancodeSpace -> over uvWorld spaceAction uv
_ -> uv
updateKeyInGame uv _ _ = uv
pauseGame :: Universe -> Universe