Further simplify right button options
This commit is contained in:
@@ -15,7 +15,6 @@ data RightButtonOptions
|
||||
| EquipOptions
|
||||
{ _opEquip :: [EquipPosition]
|
||||
, _opSel :: Int
|
||||
, _opAllocateEquipment :: EquipmentAllocation
|
||||
}
|
||||
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
|
||||
|
||||
|
||||
@@ -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}
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user