Cleanup rendering

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

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)
 

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 #-}