Refactor window size, update selection cursor on new screen

This commit is contained in:
2023-03-25 09:27:27 +00:00
parent 20c05be23f
commit ea0c942887
57 changed files with 346 additions and 310 deletions
+11 -14
View File
@@ -41,7 +41,7 @@ drawHUD cfig w = case w ^. hud . hudElement of
<> drawSubInventory subinv cfig w
drawHP :: Configuration -> World -> Picture
drawHP cfig w = winScale cfig . dShadCol white $ displayHP 0 cfig w
drawHP cfig w = dShadCol white $ displayHP 0 cfig w
drawInventory :: SelectionSections () -> World -> Configuration -> Picture
@@ -265,7 +265,7 @@ eqPosText ep = case ep of
OnSpecial -> "EQUIPPED"
combineCounts :: Configuration -> World -> [Int] -> Picture
combineCounts cfig w = winScale cfig . foldMap f . group
combineCounts cfig w = foldMap f . group
where
f (i : is) = fromMaybe mempty $ do
_ <- yourInv w ^? ix i . itUse . useAmount
@@ -277,8 +277,7 @@ combineCounts cfig w = winScale cfig . foldMap f . group
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
lnkMidPosInvSelsCol cfig w i col =
winScale cfig
. foldMap f
foldMap f
where
f j = fromMaybe mempty $ do
sss <- w ^? hud . hudElement . diSections
@@ -302,8 +301,7 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
invHead :: Configuration -> String -> Picture
invHead cfig =
winScale cfig
. translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
translate (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 40)
. dShadCol white
. scale 0.4 0.4
. text
@@ -314,7 +312,7 @@ drawCarte cfig w =
renderListAt 0 0 cfig locs :
-- zipWith bConnect (displayListEndCoords cfig locTexts) locPoss
-- ++
mapOverlay cfig w
mapOverlay w
++ [mainListCursor white iPos cfig]
where
iPos = w ^. cWorld . lWorld . selLocation
@@ -330,17 +328,17 @@ drawCarte cfig w =
-- h :: String -> Point2 -> Point2
-- h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w =
mapOverlay :: World -> [Picture]
mapOverlay w =
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
[foldMap (drawMapWall cfig (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
[foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
where
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
lw = w ^. cWorld . lWorld
drawMapWall :: Configuration -> HUD -> Wall -> Picture
drawMapWall cfig thehud wl = color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
drawMapWall :: HUD -> Wall -> Picture
drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x +.+ n2, y +.+ n2, y]
where
t = normalizeV (y -.- x)
n2 = 20 *.* vNormal t
@@ -420,8 +418,7 @@ openCursorAt ::
Configuration ->
Picture
openCursorAt wth col xoff yoff yint w =
winScale w
. translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20)
translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20)
$ lineCol
[ (V2 wth 12.5, withAlpha 0 col)
, (V2 0 12.5, col)