diff --git a/src/Dodge/Inventory/RBList.hs b/src/Dodge/Inventory/RBList.hs index cb5bad290..51b76580d 100644 --- a/src/Dodge/Inventory/RBList.hs +++ b/src/Dodge/Inventory/RBList.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index f8cde9c88..ac5514bd4 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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