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
+6 -9
View File
@@ -144,7 +144,6 @@ performAction cr w ac = case ac of
(imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac) (imps, _) -> (imps, Just $ DoReplicatePartial startac (t -1) startac)
NoAction -> ([], Nothing) NoAction -> ([], Nothing)
setMinInvSize :: Int -> Creature -> World -> World setMinInvSize :: Int -> Creature -> World -> World
setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n setMinInvSize n cr = cWorld . lWorld . creatures . ix (_crID cr) . crInvCapacity .~ n
@@ -187,21 +186,19 @@ dropItem cr invid = rmInvItem cid invid . copyInvItemToFloor cr invid -- . maybe
-- Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing -- Just i | i == invid -> creatures . ix cid . crLeftInvSel .~ Nothing
-- _ -> id -- _ -> id
-- | Get your creature to drop the item under the cursor.
youDropItem :: World -> World youDropItem :: World -> World
youDropItem w youDropItem w
| _crInvLock (you w) = w | _crInvLock (you w) || cursed = w
| otherwise = youDropItem' w | otherwise =
-- | Get your creature to drop the item under the cursor.
youDropItem' :: World -> World
youDropItem' w = case yourItem w ^? _Just . itCurseStatus of
Just Uncursed ->
w w
& dropItem cr (crSel cr) & dropItem cr (crSel cr)
& soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing & soundStart (CrSound (_crID cr)) (_crPos cr) whiteNoiseFadeOutS Nothing
_ -> w
where where
cr = you w cr = you w
cursed = fromMaybe True $ do
it <- yourItem w
return $ it ^. itCurseStatus /= Uncursed
-- | Copy an inventory item to the floor. -- | Copy an inventory item to the floor.
copyInvItemToFloor :: Creature -> Int -> World -> World copyInvItemToFloor :: Creature -> Int -> World -> World
+1 -1
View File
@@ -15,7 +15,7 @@ data RightButtonOptions
| EquipOptions | EquipOptions
{ _opEquip :: [EquipPosition] { _opEquip :: [EquipPosition]
, _opSel :: Int , _opSel :: Int
, _opCurInvPos :: Int , _opItemID :: Int
, _opAllocateEquipment :: AllocateEquipment , _opAllocateEquipment :: AllocateEquipment
, _opActivateEquipment :: ActivateEquipment , _opActivateEquipment :: ActivateEquipment
} }
+12 -9
View File
@@ -185,22 +185,25 @@ updateCloseObjects w =
updateRBList :: World -> World updateRBList :: World -> World
updateRBList w updateRBList w
| w ^? rbOptions . opCurInvPos == Just curinvid = | w ^? rbOptions . opItemID == mcurrentitemid =
w & setEquipAllocation & setEquipActivation w & setEquipAllocation & setEquipActivation
| otherwise = case cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite of | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
Just esite -> esite <- cr ^? crInv . ix curinvid . itUse . equipEffect . eeSite
itid <- mcurrentitemid
return $
w w
& rbOptions & rbOptions
.~ EquipOptions .~ EquipOptions
(equipSiteToPositions esite) { _opEquip = (equipSiteToPositions esite)
(chooseEquipmentPosition cr (equipSiteToPositions esite)) , _opSel = (chooseEquipmentPosition cr (equipSiteToPositions esite))
curinvid , _opItemID = itid
DoNotMoveEquipment , _opAllocateEquipment = DoNotMoveEquipment
NoChangeActivateEquipment , _opActivateEquipment = NoChangeActivateEquipment
}
& setEquipAllocation & setEquipAllocation
& setEquipActivation & setEquipActivation
Nothing -> w & rbOptions .~ NoRightButtonOptions
where where
mcurrentitemid = cr ^? crInv . ix curinvid . itID
curinvid = crSel cr curinvid = crSel cr
cr = you w cr = you w
+4
View File
@@ -80,6 +80,10 @@ updateKeyInGame uv sc InitialPress = case sc of
ScancodeX -> uv & uvWorld %~ toggleTweakInv ScancodeX -> uv & uvWorld %~ toggleTweakInv
ScancodeC -> over uvWorld toggleCombineInv uv ScancodeC -> over uvWorld toggleCombineInv uv
_ -> uv _ -> uv
updateKeyInGame uv sc LongPress = case sc of
ScancodeF -> over uvWorld youDropItem uv
ScancodeSpace -> over uvWorld spaceAction uv
_ -> uv
updateKeyInGame uv _ _ = uv updateKeyInGame uv _ _ = uv
pauseGame :: Universe -> Universe pauseGame :: Universe -> Universe