From 6081f90f909aac1af785023da59fe8839e0d5a29 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 10 May 2023 21:26:17 +0100 Subject: [PATCH] Cleanup rendering --- src/Dodge/ListDisplayParams.hs | 2 +- src/Dodge/Render/HUD.hs | 64 +++------------------------------- src/Picture/Base.hs | 29 +++++++++++---- 3 files changed, 28 insertions(+), 67 deletions(-) diff --git a/src/Dodge/ListDisplayParams.hs b/src/Dodge/ListDisplayParams.hs index da84cba51..37cdf6a92 100644 --- a/src/Dodge/ListDisplayParams.hs +++ b/src/Dodge/ListDisplayParams.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 14aba7f5d..d2111f7ef 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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) diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 86f6ecd17..628004233 100644 --- a/src/Picture/Base.hs +++ b/src/Picture/Base.hs @@ -25,7 +25,10 @@ module Picture.Base ( line, lineCol, text, + textRight, + textJustifyLeft, textJustifyRight, + textJustifyCenter, textVMirror, drawText, centerText, @@ -90,7 +93,6 @@ poly3Col = map f . polyToTris where f (pos, col) = Verx pos col [] BottomLayer polyNum - ---- given a one and two zeros of a linear function over x and y, ---- determine the function ---- so if f(ox,oy) = 1 and f(ax,ay) = f(bx,by) = 0, determines f @@ -201,15 +203,28 @@ stackText :: [String] -> Picture {-# INLINE stackText #-} stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..] -textJustifyRight :: String -> Picture -{-# INLINE textJustifyRight #-} -textJustifyRight str = translate ((-100) * fromIntegral (length str)) 0 $ text str - text :: String -> Picture {-# INLINE text #-} ---text = translate (-50) (-100) . drawText (-10) text = drawText 0 ---text = drawText (-10) + +-- lines up the rightmost part of the last character with 0 +textJustifyRight :: String -> Picture +{-# INLINE textJustifyRight #-} +textJustifyRight str = translate (12.5 + (-100) * fromIntegral (length str)) 0 $ text str + +-- translate the text so its bottom right coordinate is at (0,0) +textRight :: String -> Picture +{-# INLINE textRight #-} +textRight str = translate ((-100) * fromIntegral (length str)) 0 $ text str + +-- lines up the leftmost part of the first character with 0 +textJustifyLeft :: String -> Picture +{-# INLINE textJustifyLeft #-} +textJustifyLeft = translate (-12.5) 0 . text + +textJustifyCenter :: String -> Picture +{-# INLINE textJustifyCenter #-} +textJustifyCenter str = translate ((-50) * fromIntegral (length str)) 0 $ text str textVMirror :: String -> Picture {-# INLINE textVMirror #-}