Cleanup rendering

This commit is contained in:
2023-05-10 21:26:17 +01:00
parent 5f238a65d0
commit 6081f90f90
3 changed files with 28 additions and 67 deletions
+1 -1
View File
@@ -47,7 +47,7 @@ secondColumnParams =
& ldpCursorSides .~ [North, South, West]
subInvX :: Float
subInvX = 9 * fromIntegral topInvW + 50
subInvX = 10 * fromIntegral topInvW + 50
topInvW :: Int
topInvW = 15
+5 -59
View File
@@ -3,6 +3,7 @@ module Dodge.Render.HUD (
drawHUD,
) where
import Dodge.Render.HUD.Carte
import Dodge.ScreenPos
import Control.Lens
import Control.Monad
@@ -236,21 +237,12 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
invHead :: Configuration -> String -> Picture
invHead cfig =
translateScreenPos cfig (fromTopLeft (V2 (subInvX + 20) 80))
translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
-- (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 80)
. dShadCol white
. scale 0.4 0.4
. text
. textJustifyLeft
drawCarte :: Configuration -> World -> Picture
drawCarte cfig w =
pictures $
toTopLeft cfig (renderListAt 0 0 locs) :
mapOverlay w
++ [mainListCursor white iPos cfig]
where
iPos = w ^. cWorld . lWorld . selLocation
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
--locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
--locTexts = map fst locs
@@ -263,31 +255,6 @@ drawCarte cfig w =
-- h :: String -> Point2 -> Point2
-- h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
mapOverlay :: World -> [Picture]
mapOverlay w =
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
[foldMap (drawMapWall (w ^. hud)) $ IM.restrictKeys (lw ^. walls) (w ^. cWorld . seenWalls)]
where
lw = w ^. cWorld . lWorld
--(mapMaybe (mapWall cfig (w ^. hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
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
(x, y) = _wlLine wl
c = _wlColor wl
--mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
--mapWall cfig thehud wl
-- | _wlSeen wl = Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
-- | otherwise = Nothing
-- where
-- t = normalizeV (y -.- x)
-- n2 = 20 *.* vNormal t
-- (x, y) = _wlLine wl
-- c = _wlColor wl
--selectedCloseObjectLink :: Configuration -> World -> Picture
--selectedCloseObjectLink cfig w = mempty
@@ -321,8 +288,6 @@ drawMapWall thehud wl = color c . polygon $ map (cartePosToScreen thehud) [x, x
-- ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
-- return . winScale cfig . color col $ lConnect p itScreenPos
mainListCursor :: Color -> Int -> Configuration -> Picture
mainListCursor c = openCursorAt 120 c 5 0
textSelItems :: [String] -> [SelectionItem ()]
textSelItems = map (picsToSelectable . (: []))
@@ -338,32 +303,13 @@ picsToSelectable pics =
, _siPayload = ()
}
openCursorAt ::
-- | Width
Float ->
Color ->
-- | x offset
Float ->
-- | y offset
Float ->
-- | y offset (discrete)
Int ->
Configuration ->
Picture
openCursorAt wth col xoff yoff yint w =
translate (xoff - halfWidth w) (halfHeight w - (20 * fromIntegral yint + yoff) - 20) $
lineCol
[ (V2 wth 12.5, withAlpha 0 col)
, (V2 0 12.5, col)
, (V2 0 (-7.5), col)
, (V2 wth (-7.5), withAlpha 0 col)
]
displayHP :: Int -> Configuration -> World -> Picture
displayHP cid cfig =
translate (halfWidth cfig) (halfHeight cfig -40)
. scale 0.2 0.2
. textJustifyRight
. textRight
. show
. (^?! cWorld . lWorld . creatures . ix cid . crHP)