Allow for equip/unequip with single left click

This commit is contained in:
2023-05-15 12:11:15 +01:00
parent ddb72690b1
commit 05bc7c6655
2 changed files with 16 additions and 12 deletions
+15 -10
View File
@@ -4,6 +4,7 @@ module Dodge.Inventory.RBList (
equipSiteToPositions,
) where
import Control.Applicative
import Control.Lens
import Data.List (elemIndex, findIndex)
import qualified Data.Map.Strict as M
@@ -30,11 +31,25 @@ updateRBList w
where
cr = you w
-- want to choose the current position if the item is equipped, otherwise try to
-- find a free equipment slot
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
getEquipmentAllocation :: World -> EquipmentAllocation
getEquipmentAllocation w = fromMaybe DoNotMoveEquipment $ do
curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
esite <- you w ^? crInv . ix curpos . itUse . equipEffect . eeSite
i <- w ^? rbOptions . opSel
<|> Just (chooseEquipmentPosition (you w) (equipSiteToPositions esite))
es <- equipSiteToPositions esite ^? ix i
return $ case you w ^? crInvEquipped . ix curpos of
Just epos
@@ -67,13 +82,3 @@ equipSiteToPositions es = case es of
GoesOnWrist -> [OnLeftWrist, OnRightWrist]
GoesOnLegs -> [OnLegs]
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
+1 -2
View File
@@ -163,8 +163,7 @@ drawRBOptions cfig w = fromMaybe mempty $ do
maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1
maybetopborder _ _ = mempty
maybebottomborder a b curpos
| a == b - 1 =
listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
| a == b - 1 = listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
| otherwise = mempty
otheritem j = fromMaybe "" $ do
itm <- you w ^? crInv . ix j