Further simplify right button options

This commit is contained in:
2023-05-15 11:39:43 +01:00
parent 0e450f7bc7
commit c4ec84c0f9
3 changed files with 12 additions and 11 deletions
-1
View File
@@ -15,7 +15,6 @@ data RightButtonOptions
| EquipOptions
{ _opEquip :: [EquipPosition]
, _opSel :: Int
, _opAllocateEquipment :: EquipmentAllocation
}
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
+4 -4
View File
@@ -1,6 +1,7 @@
module Dodge.Inventory.RBList (
updateRBList,
getEquipmentAllocation,
equipSiteToPositions,
) where
import Control.Lens
@@ -16,7 +17,7 @@ updateRBList w
| not (SDL.ButtonRight `M.member` (w ^. input . mouseButtons)) =
w & rbOptions .~ NoRightButtonOptions
| otherwise = case w ^. rbOptions of
EquipOptions{} -> w & rbOptions . opAllocateEquipment .~ (getEquipmentAllocation w)
EquipOptions{} -> w
_ -> fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
i <- cr ^? crManipulation . manObject . inInventory . ispItem
esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
@@ -26,17 +27,16 @@ updateRBList w
.~ EquipOptions
{ _opEquip = equipSiteToPositions esite
, _opSel = chooseEquipmentPosition cr (equipSiteToPositions esite)
, _opAllocateEquipment = DoNotMoveEquipment
}
& rbOptions . opAllocateEquipment .~ (getEquipmentAllocation w)
where
cr = you w
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
es <- w ^? rbOptions . opEquip . ix i
es <- equipSiteToPositions esite ^? ix i
return $ case you w ^? crInvEquipped . ix curpos of
Just epos
| es == epos -> RemoveEquipment{_allocOldPos = epos}
+8 -6
View File
@@ -3,6 +3,7 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.Inventory.RBList
import Control.Lens
import Control.Monad
import qualified Data.Map.Strict as M
@@ -122,9 +123,10 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
drawRBOptions :: Configuration -> World -> Picture
drawRBOptions cfig w = fromMaybe mempty $ do
guard $ ButtonRight `M.member` _mouseButtons (_input w)
es <- w ^? rbOptions . opEquip
invid <- you w ^? crManipulation . manObject . inInventory . ispItem
eslist <- fmap equipSiteToPositions $ you w ^? crInv . ix invid . itUse . equipEffect . eeSite
i <- w ^? rbOptions . opSel
ae <- w ^? rbOptions . opAllocateEquipment
let ae = getEquipmentAllocation w
sss <- w ^? hud . hudElement . diSections
(i', j) <- sss ^? sssExtra . sssSelPos . _Just
curpos <- selSecYint i' j sss
@@ -149,12 +151,12 @@ drawRBOptions cfig w = fromMaybe mempty $ do
<> translate
380
(-1)
( drawListYoff (curpos - i) (map (text . eqPosText) es)
<> listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es)
<> listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i + 1))
( drawListYoff (curpos - i) (map (text . eqPosText) eslist)
<> listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length eslist)
<> listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length eslist - (i + 1))
<> listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i
<> maybetopborder i curpos
<> maybebottomborder i (length es) curpos
<> maybebottomborder i (length eslist) curpos
)
<> translate 460 (-1) (ytext extrastr)
where