Work on cursor for lists

src/Dodge/Render/List.hs

@@ -1,10 +1,10 @@
 module Dodge.Render.List (
     renderListAt,
     listCursorNSW,
-    listPicturesAt,
+    drawList,
     drawSelectionList,
     listPicturesAtScaleOff,
-    listTextPictureAtScale,
+    drawListElement,
     selSecDrawCursor,
     dShadCol,
     listPicturesAtOff,
@@ -26,13 +26,16 @@ import Picture
 
 drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
 drawSelectionList ldps cfig sl =
-    toTopLeft cfig ((translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $ listPicturesAtScaleOff
-        (_ldpVerticalGap ldps)
-        (_ldpScale ldps)
-        0
-        (makeSelectionListPictures sl)
-        )
-        <> drawSelectionCursor ldps sl
+    toTopLeft
+        cfig
+        ( ( translate (ldps ^. ldpPosX) (negate $ ldps ^. ldpPosY) $
+                listPicturesAtScaleOff
+                    (_ldpVerticalGap ldps)
+                    (_ldpScale ldps)
+                    0
+                    (makeSelectionListPictures sl)
+          )
+            <> drawSelectionCursor ldps sl
         )
 
 makeSelectionListPictures :: SelectionList a -> [Picture]
@@ -44,12 +47,20 @@ drawCursorAt :: ListDisplayParams -> Maybe Int -> [SelectionItem a] -> Picture
 drawCursorAt ldps mi lis = fromMaybe mempty $ do
     i <- mi
     selit <- lis !? i
-    f <- case _ldpCursorType ldps of
-        BorderCursor cps -> Just $ listCursorChooseBorderScale (_ldpVerticalGap ldps) (_ldpScale ldps) cps
-        NoCursor -> Nothing
     let j = sum . map _siHeight $ take i lis
         col = _siColor selit
-    return $ f (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit))) (_ldpPosY ldps) j 0 col wdth (_siHeight selit)
+    return $
+        listCursorChooseBorderScale
+            (_ldpVerticalGap ldps)
+            (_ldpScale ldps)
+            (ldps ^. ldpCursorSides)
+            (_ldpPosX ldps + (9 * fromIntegral (_siOffX selit)))
+            (_ldpPosY ldps)
+            j
+            0
+            col
+            wdth
+            (_siHeight selit)
   where
     wdth = case _ldpWidth ldps of
         FixedSelectionWidth x -> x
@@ -65,18 +76,18 @@ drawSelectionCursor ldps sl = drawCursorAt ldps (f $ sl ^. slSelPos) (getShownIt
         _ -> fmap (+ 1)
 
 listPicturesAtOff :: Int -> [Picture] -> Picture
-listPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i ..]
+listPicturesAtOff = listPicturesAtScaleOff 10 1
 
 listPicturesAtScaleOff :: Float -> Float -> Int -> [Picture] -> Picture
 listPicturesAtScaleOff ygap s i =
     mconcat
-        . zipWith (listTextPictureAtScale ygap s) [i ..]
+        . zipWith (drawListElement ygap s) [i ..]
 
 stackPicturesAt :: [Picture] -> Picture
 stackPicturesAt = stackPicturesAtOff 0
 
 stackPicturesAtOff :: Int -> [Picture] -> Picture
-stackPicturesAtOff i = mconcat . zipWith (listTextPictureAtScale 10 1) [i, i -1 ..]
+stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1) [i, i -1 ..]
 
 selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
 selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do
@@ -120,7 +131,7 @@ listCursorChooseBorderScale ::
 listCursorChooseBorderScale ygap s borders xoff yoff yint xint col cursxsize cursysize =
     translate
         (xoff + (10 * s * (fromIntegral xint -1)))
-        ( - (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
+        (- (yoff + (s * 10 + ygap) * (fromIntegral yint + 1)))
         . color col
         $ chooseCursorBorders (s * wth) (s * hgt) borders
   where
@@ -165,18 +176,18 @@ listCursorNSW = listCursorChooseBorder [North, South, West]
 --    thescale = hw * 0.02 / fromIntegral (length str)
 --    hw = halfWidth cfig
 
-listTextPictureAtScale :: Float -> Float -> Int -> Picture -> Picture
-listTextPictureAtScale ygap s yint =
+drawListElement :: Float -> Float -> Int -> Picture -> Picture
+drawListElement ygap s yint =
     translate 0 (negate ((s * 10 + ygap) * (fromIntegral yint + 1)))
         . scale (s * 0.1) (s * 0.1)
 
 renderListAt :: Float -> Float -> [(String, Color)] -> Picture
-renderListAt tx ty = translate tx (-ty) . listPicturesAt . map (\(str, col) -> color col $ text str)
+renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str)
 
 -- given a list of pictures that are each the size of a "text" call, displays them as
 -- a list on the screen
-listPicturesAt :: [Picture] -> Picture
-listPicturesAt = listPicturesAtScaleOff 10 1 0
+drawList :: [Picture] -> Picture
+drawList = listPicturesAtScaleOff 10 1 0
 
 --TODO put the following functions in an appropriate place
 
@@ -186,7 +197,7 @@ dShadCol :: Color -> Picture -> Picture
 dShadCol c p = color black (translate 1.2 (-1.2) p) <> color c p
 
 toTopLeft :: Configuration -> Picture -> Picture
-toTopLeft cfig = translate (-hw) (hh)
+toTopLeft cfig = translate (- hw) (hh)
   where
     hw = halfWidth cfig
     hh = halfHeight cfig