justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Continue selection refactor

Browse Source
This commit is contained in:
justin
2024-11-20 16:15:51 +00:00
parent 3ecf137801
commit 1f5d034c5f
9 changed files with 159 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/HUD.hs
+5 -4
View File
@@ -4,6 +4,7 @@ module Dodge.Render.HUD (
drawHUD,
) where
import qualified Data.IntSet as IS
import Control.Applicative
import Control.Lens
import Control.Monad
@@ -146,15 +147,15 @@ drawMouseOver cfig w = concat (invsel <|> combinvsel
drawDragSelected :: Configuration -> World -> Maybe Picture
drawDragSelected cfig w = do
y <- w ^? hud . hudElement . diSelectionExtra
guard $ y > 0
ys <- w ^? hud . hudElement . diSelectionExtra
guard $ not (IS.null ys)
(i,j) <- w ^? hud . hudElement . diSelection . _Just
guard $ i == 0
sss <- w ^? hud . hudElement . diSections
let idp = invDisplayParams w
let f x = selSecDrawCursorAt 15 idp BackdropCursor sss (0, x)
let f x = (selSecDrawCursorAt 15 idp BackdropCursor sss (0, x) <>)
return . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
. color (withAlpha 0.2 white) . foldMap f $ [j .. j + y]
. color (withAlpha 0.2 white) . IS.foldr f mempty $ IS.insert j ys
drawDragSelect :: Configuration -> World -> Maybe Picture
drawDragSelect cfig w = do