Work on terminal text display

src/Dodge/Render/List.hs

@@ -36,14 +36,18 @@ import Picture
 drawSelectionList :: ListDisplayParams -> Config -> [SelectionItem a] -> Picture
 drawSelectionList ldps cfig sl =
     translateScreenPos cfig (ldps ^. ldpPos) $
-        drawListYgapScaleYoff
-            (ldps ^. ldpVerticalGap)
-            (ldps ^. ldpScale)
-            0
-            (makeSelectionListPictures sl)
-        <> foldMap (color white . polygonWire . f) (ldps ^. ldpBorder)
+        drawListYgapScaleYoff ygap sf 0 (makeSelectionListPictures sl)
+            <> foldMap (g . f) (ldps ^. ldpBorder)
   where
-    f (x,y) = rectNSWE 5 (negate $ 20 * fromIntegral y + 5) (-5) (10 * fromIntegral x)
+    g xs = color white (polygonWire xs) <> setDepth 0.5 (polygon xs)
+    ygap = ldps ^. ldpVerticalGap
+    sf = ldps ^. ldpScale
+    f (x, y) =
+        rectNSWE
+            5
+            (negate $ (20 * sf + ygap) * fromIntegral y + 5)
+            (-5)
+            (10 * sf * fromIntegral x)
 
 drawTitleBackground :: Config -> Picture
 drawTitleBackground cfig =
@@ -63,7 +67,7 @@ drawSelectionListBackground ldp cfig l =
         . reverse
         $ rectNSWE 5 s (-5) e
   where
-    s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
+    s = -(5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
     e = 555 -- HACK isOverTerminalScreen
 
 makeSelectionListPictures :: [SelectionItem a] -> [Picture]
@@ -103,7 +107,7 @@ stackPicturesAt :: [Picture] -> Picture
 stackPicturesAt = stackPicturesAtOff 0
 
 stackPicturesAtOff :: Int -> [Picture] -> Picture
-stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
+stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i - 1 ..]
 
 selSecDrawCursorAt ::
     ListDisplayParams ->
@@ -148,7 +152,7 @@ listCursorChooseBorderScale ::
 listCursorChooseBorderScale ygap s curs yint xint col cursxsize cursysize =
     translate
         ((10 * fromIntegral xint - 5) * s)
-        (- (ygap + (s * 20 + ygap) * fromIntegral yint))
+        (-(ygap + (s * 20 + ygap) * fromIntegral yint))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) curs
   where
@@ -167,8 +171,8 @@ chooseCursorBorders w h = \case
     toLine South = [V2 w h', V2 0 h']
     toLine West = [V2 0 h', V2 0 0]
 
---fillScreenText :: Config -> String -> Picture
---fillScreenText cfig str =
+-- fillScreenText :: Config -> String -> Picture
+-- fillScreenText cfig str =
 --    scale wscale hscale
 --        . centerText
 --        $ str
@@ -178,8 +182,8 @@ chooseCursorBorders w h = \case
 --    hw = halfWidth cfig
 --    hh = halfHeight cfig
 
---fillWidthText :: Config -> String -> Picture
---fillWidthText cfig str =
+-- fillWidthText :: Config -> String -> Picture
+-- fillWidthText cfig str =
 --    scale thescale thescale
 --        . centerText
 --        $ str
@@ -193,12 +197,13 @@ drawListElement ygap s xint yint =
         . scale (s * 0.1) (s * 0.1)
 
 renderListAt :: Float -> Float -> [(String, Color)] -> Picture
-renderListAt tx ty = translate tx (- ty) 
-    . drawList 
-    . map (\(str, col) -> color col $ text str)
+renderListAt tx ty =
+    translate tx (-ty)
+        . drawList
+        . map (\(str, col) -> color col $ text str)
 
---inverseText :: String -> Color -> Picture
---inverseText str col =
+-- inverseText :: String -> Color -> Picture
+-- inverseText str col =
 --    translate3 (V3 0 0 (0.5))
 --    (color (V4 0 1 0 0.1) ( text str))
 --    <>
@@ -212,14 +217,14 @@ renderListAt tx ty = translate tx (- ty)
 drawList :: [Picture] -> Picture
 drawList = drawListYgapScaleYoff 0 1 0
 
-drawLabelledList :: [(String,[String])] -> Picture
-drawLabelledList ((s,ss):xs) 
-    = translate (-10) 0 (drawListYgapScaleYoff 0 1 0 [ textJustifyRight s])
-    <> drawListYgapScaleYoff 0 1 0 (text <$> ss)
-    <> translate 0 (negate $ fromIntegral (max 1 $ length ss) * 20) (drawLabelledList xs)
+drawLabelledList :: [(String, [String])] -> Picture
+drawLabelledList ((s, ss) : xs) =
+    translate (-10) 0 (drawListYgapScaleYoff 0 1 0 [textJustifyRight s])
+        <> drawListYgapScaleYoff 0 1 0 (text <$> ss)
+        <> translate 0 (negate $ fromIntegral (max 1 $ length ss) * 20) (drawLabelledList xs)
 drawLabelledList [] = mempty
 
---TODO put the following functions in an appropriate place
+-- TODO put the following functions in an appropriate place
 
 -- | Colour picture and add black drop shadow.
 dShadCol :: Color -> Picture -> Picture
@@ -227,4 +232,4 @@ dShadCol :: Color -> Picture -> Picture
 dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
 
 toTopLeft :: Config -> Picture -> Picture
-toTopLeft cfig = translate (- halfWidth cfig) (halfHeight cfig)
+toTopLeft cfig = translate (-halfWidth cfig) (halfHeight cfig)