Improve combine menu visuals

This commit is contained in:
2022-05-24 15:25:05 +01:00
parent 7f55ba117f
commit 7c472c4ca4
4 changed files with 37 additions and 68 deletions
+29 -25
View File
@@ -101,6 +101,7 @@ subInventoryDisplay subinv cfig w = case subinv of
cpos <- combinePoss w !? i
csize <- combineSizes w !? i
col <- (combineItemListYou w !? i) <&> _itInvColor . snd
--return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
, fromMaybe mempty $ do
i <- mi
@@ -108,7 +109,7 @@ subInventoryDisplay subinv cfig w = case subinv of
col <- (combineItemListYou w !? i) <&> _itInvColor . snd
lnks <- map fst (combineItemListYou w) !? i
return $ lnkMidPosInvSelsCol cfig w cpos col lnks
<> foldMap (cursorAtInvSel listCursorNESW cfig w) lnks
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks
<> combineCounts cfig w lnks
]
InspectInventory -> invHead cfig "INSPECT"
@@ -119,7 +120,7 @@ subInventoryDisplay subinv cfig w = case subinv of
itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
cr = you w
it = yourItem w
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol topInvW cury <$ it
selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
selcursor = selcursor' selcursortype
selcursortype
| ButtonRight `S.member` _mouseButtons w = listCursorNESW
@@ -127,43 +128,40 @@ subInventoryDisplay subinv cfig w = case subinv of
curpos = invSelPos w
cury = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
equipcursor = case _crLeftInvSel cr of
Just invid | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
-> f cyan invid (_crInvEquipped cr IM.! invid)
Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
_ -> mempty
equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
f col invid epos
| _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
= listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
| otherwise = mempty
f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
-- | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
-- = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
-- | otherwise = mempty
--rboptions = listTextPicturesAtOffset 200 0 cfig (selNumPos invid w) ["TEST","ME"]
rboptions = drawRBOptions cfig w (_rbOptions w)
drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} =
listTextPicturesAtOffset 252 0 cfig (curpos-i) (map (text . eqPosText) es)
listTextPicturesAtOffset 342 0 cfig (curpos-i) (map (text . eqPosText) es)
<> case ae of
DoNotMoveEquipment -> mempty
PutOnEquipment {}
-> putontext
MoveEquipment {_allocOldPos = oldp }
-> putontext <> extratext ("MOVES FROM "++eqPosText oldp)
-> midtext "PUT ONTO"
MoveEquipment {}
-> midtext "MOVE TO" <> extratext []
SwapEquipment { _allocOldPos = oldp, _allocSwapID = sid }
-> putontext <> extratext ("SWAPS "++otheritem sid ++ " ONTO " ++eqPosText oldp)
-> midtext "MOVE TO" <> extratext ("SWAPS "++otheritem sid ++ " ONTO " ++eqPosText oldp)
ReplaceEquipment { _allocRemoveID = rid }
-> putontext <> extratext ("REMOVES " ++ otheritem rid)
-> midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
RemoveEquipment { }
-> takeofftext
-> midtext "TAKE OFF"
where
takeofftext = listTextPictureAt 144 0 cfig curpos (text " TAKE OFF")
putontext = listTextPictureAt 144 0 cfig curpos (text " PUT ONTO")
extratext str = listTextPictureAt 350 0 cfig curpos (text (str ++ deactivatetext))
midtext str = listTextPictureAt 252 0 cfig curpos (text str)
extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
Just k -> " DEACTIVATES " ++ _itName (_crInv (you w) IM.! k)
Nothing -> ""
curpos = invSelPos w
otheritem j = _itName (_crInv (you w) IM.! j)
drawRBOptions _ _ _ = mempty
eqPosText :: EquipPosition -> String
eqPosText ep = case ep of
@@ -206,23 +204,29 @@ combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = winScale cfig . foldMap f . group
where
f (i:is) = case yourInv w ^? ix i . itConsumption of
Just _ -> color (selNumCol i w) $ uncurryV translate (V2 10 5 +.+ selNumMidHeight cfig w i) . scale 0.1 0.1 . text . show $ length is + 1
Nothing -> mempty
Just ItemItselfConsumable{} -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
_ -> mempty
f _ = mempty
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col = winScale cfig
. concatMap (\j -> zConnectCol rp (selNumMidHeight cfig w j) col white white (selNumCol j w))
. concatMap (\j -> zConnectCol rp (V2 18 0+selNumMidHeight cfig w j) col white white (selNumCol j w))
where
-- lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))
hh = halfHeight cfig
hw = halfWidth cfig
cursorAtInvSel :: (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture)
topCursorTypeWidth :: (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture)
-> Int
-> Configuration -> World -> Int -> Picture
cursorAtInvSel ctype cfig w i
= ctype 0 0 cfig (selNumPos i w) (selNumCol i w) topInvW (selNumSlots i w)
topCursorTypeWidth ctype width cfig w i
= ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
determineInvSelCursorWidth :: World -> Int
determineInvSelCursorWidth w = case _rbOptions w of
NoRightButtonOptions -> topInvW
EquipOptions {} -> 47
--listSelHeight :: Configuration -> World -> Int -> Float
--listSelHeight