Work on rendering lists

src/Dodge/Render/List.hs

@@ -1,16 +1,23 @@
-module Dodge.Render.List where
+module Dodge.Render.List (
+    renderListAt,
+    listCursorNSW,
+    listPicturesAt,
+    drawSelectionList,
+    listPicturesAtScaleOff,
+    listTextPictureAtScale,
+    selSecDrawCursor,
+    dShadCol,
+    listPicturesAtOff,
+    stackPicturesAt,
+) where
 
---import Picture.Text
-
---import Data.Foldable
-
-import Dodge.SelectionSections
 import Data.Maybe
 import Dodge.Base.Window
 import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.SelectionList
+import Dodge.SelectionSections
 import Geometry
 import LensHelp
 import ListHelp
@@ -33,8 +40,6 @@ makeSelectionListPictures sl = concatMap f $ getShownItems sl
   where
     f si = map (color (_siColor si) . text) $ _siPictures si
 
---f si = map (textGrad (_siColor si) (withAlpha 0 (_siColor si))) $ _siPictures si
-
 drawCursorAt :: ListDisplayParams -> Configuration -> Maybe Int -> [SelectionItem a] -> Picture
 drawCursorAt ldps cfig mi lis = fromMaybe mempty $ do
     i <- mi
@@ -65,16 +70,18 @@ listPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
 listPicturesAt tx ty cfig = listPicturesAtScaleOff 10 1 tx ty cfig 0
 
 listPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
-listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i ..]
+listPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i ..]
 
 listPicturesAtScaleOff :: Float -> Float -> Float -> Float -> Configuration -> Int -> [Picture] -> Picture
-listPicturesAtScaleOff ygap s tx ty cfig i = mconcat . zipWith (listTextPictureAtScale ygap s tx ty cfig) [i ..]
+listPicturesAtScaleOff ygap s tx ty cfig i =
+    mconcat
+        . zipWith (listTextPictureAtScale ygap s tx ty cfig) [i ..]
 
 stackPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
 stackPicturesAt tx ty cfig = stackPicturesAtOff tx ty cfig 0
 
 stackPicturesAtOff :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
-stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i, i -1 ..]
+stackPicturesAtOff tx ty cfig i = mconcat . zipWith (listTextPictureAtScale 10 1 tx ty cfig) [i, i -1 ..]
 
 selSecDrawCursor :: Int -> [CardinalPoint] -> Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
 selSecDrawCursor xsize borders cfig ldp sss i j = fromMaybe mempty $ do
@@ -120,7 +127,7 @@ listCursorChooseBorderScale ::
 listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsize cursysize =
     translate
         --(15 + (9 * s * (fromIntegral xint - 1)) + xoff - halfWidth cfig)
-        (xoff - halfWidth cfig)
+        (xoff + (10 * s * (fromIntegral xint -1)) - halfWidth cfig)
         (halfHeight cfig - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) borders
@@ -130,8 +137,6 @@ listCursorChooseBorderScale ygap s borders xoff yoff cfig yint xint col cursxsiz
     hgt = 20 * fromIntegral cursysize -- TODO this should be changed!
 
 -- displays a cursor that should match up to list text pictures
--- the width of a character appears to be 9(?!)
--- this is probably because it is 8 pixels plus one for the border
 listCursorChooseBorder ::
     [CardinalPoint] -> Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorChooseBorder = listCursorChooseBorderScale 10 1
@@ -145,49 +150,32 @@ chooseCursorBorders w h = foldMap (line . toLine)
     toLine South = [V2 w 0, V2 0 0]
     toLine West = [V2 0 0, V2 0 h]
 
-listCursorNS :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
-listCursorNS = listCursorChooseBorder [North, South]
-
-listCursorNES :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
-listCursorNES = listCursorChooseBorder [North, South, East]
-
-listCursorNESW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
-listCursorNESW = listCursorChooseBorder [North, South, East, West]
-
 listCursorNSW :: Float -> Float -> Configuration -> Int -> Int -> Color -> Int -> Int -> Picture
 listCursorNSW = listCursorChooseBorder [North, South, West]
 
-fillScreenText :: Configuration -> String -> Picture
-fillScreenText cfig str =
-    scale wscale hscale
-        . centerText
-        $ str
-  where
-    wscale = hw * 0.02 / fromIntegral (length str)
-    hscale = hh * 0.01
-    hw = halfWidth cfig
-    hh = halfHeight cfig
+--fillScreenText :: Configuration -> String -> Picture
+--fillScreenText cfig str =
+--    scale wscale hscale
+--        . centerText
+--        $ str
+--  where
+--    wscale = hw * 0.02 / fromIntegral (length str)
+--    hscale = hh * 0.01
+--    hw = halfWidth cfig
+--    hh = halfHeight cfig
 
-fillWidthText :: Configuration -> String -> Picture
-fillWidthText cfig str =
-    scale thescale thescale
-        . centerText
-        $ str
-  where
-    thescale = hw * 0.02 / fromIntegral (length str)
-    hw = halfWidth cfig
-
-listTextPictureAt :: Float -> Float -> Configuration -> Int -> Picture -> Picture
-listTextPictureAt xoff yoff cfig yint =
-    translate (xoff + 15 - hw) (negate yoff + hh - (20 * (fromIntegral yint + 1)))
-        . scale 0.1 0.1
-  where
-    hw = halfWidth cfig
-    hh = halfHeight cfig
+--fillWidthText :: Configuration -> String -> Picture
+--fillWidthText cfig str =
+--    scale thescale thescale
+--        . centerText
+--        $ str
+--  where
+--    thescale = hw * 0.02 / fromIntegral (length str)
+--    hw = halfWidth cfig
 
 listTextPictureAtScale :: Float -> Float -> Float -> Float -> Configuration -> Int -> Picture -> Picture
 listTextPictureAtScale ygap s xoff yoff cfig yint =
-    translate (xoff + 15 - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
+    translate (xoff - hw) (negate yoff + hh - ((s * 10 + ygap) * (fromIntegral yint + 1)))
         . scale (s * 0.1) (s * 0.1)
   where
     hw = halfWidth cfig
@@ -196,15 +184,9 @@ listTextPictureAtScale ygap s xoff yoff cfig yint =
 renderListAt :: Float -> Float -> Configuration -> [(String, Color)] -> Picture
 renderListAt tx ty cfig = listPicturesAt tx ty cfig . map (\(str, col) -> color col $ text str)
 
---    concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
-
 --TODO put the following functions in an appropriate place
 
 -- | Colour picture and add black drop shadow.
 dShadCol :: Color -> Picture -> Picture
 {-# INLINE dShadCol #-}
-dShadCol c p =
-    pictures
-        [ color black $ translate 1.2 (-1.2) p
-        , color c p
-        ]
+dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p