Highlight moused-over inventory items

This commit is contained in:
2024-10-16 22:14:11 +01:00
parent cf0873d73b
commit d256bc0443
9 changed files with 214 additions and 148 deletions
+26 -1
View File
@@ -5,6 +5,7 @@ module Dodge.Render.HUD (
selNumPos, -- this shoud probably be pushed back here
) where
import Dodge.SelectionSections
import Control.Lens
import Control.Monad
import qualified Data.Map.Strict as M
@@ -58,9 +59,13 @@ drawHP cfig =
drawInventory :: SelectionSections () -> World -> Configuration -> Picture
drawInventory sss w cfig =
drawSelectionSections sss (invDisplayParams w) cfig
drawSelectionSections sss ldp cfig
<> iextra
<> translateScreenPos cfig (ldp ^. ldpPos)
(drawDIMouseOver w)
<> drawDISelections w cfig
where
ldp = invDisplayParams w
iextra = fromMaybe mempty $ do
inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
let x = case invAdj inv of
@@ -68,6 +73,23 @@ drawInventory sss w cfig =
Right y -> y
return $ inventoryExtra sss cfig w x
drawDIMouseOver :: World -> Picture
drawDIMouseOver w = fromMaybe mempty $ do
(_,i) <- w ^? hud . hudElement . subInventory . nsMouseOver . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
return . color (withAlpha 0.5 white) $ selSecDrawCursorAt (0,i) 10 idp sss
drawDISelections :: World -> Configuration -> Picture
drawDISelections w cfig = fromMaybe mempty $ do
(i,j) <- w ^? hud . hudElement . subInventory . nsSelected . _Just
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
tp <- selNumPos cfig idp sss 0 i
bp <- selNumPos cfig idp sss 0 j
return . color red $ line [tp,bp]
drawSubInventory :: SubInventory -> Configuration -> World -> Picture
drawSubInventory subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
@@ -344,5 +366,8 @@ selNumPos cfig ldp sss i j = do
s = _ldpScale ldp
ygap = _ldpVerticalGap ldp
selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor