Cleanup

src/Dodge/Render/List.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 module Dodge.Render.List (
     renderListAt,
     drawList,
@@ -13,14 +14,13 @@ module Dodge.Render.List (
     selSecDrawCursorAt,
 ) where
 
-import Dodge.SelectionSections
 import Data.Maybe
 import Dodge.Base.Window
 import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.ScreenPos
-import Dodge.SelectionList
+import Dodge.SelectionSections
 import Geometry
 import LensHelp
 import ListHelp
@@ -28,38 +28,29 @@ import Picture
 
 drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Picture
 drawSelectionList ldps cfig sl =
-    translateScreenPos
-        cfig
-        (ldps ^. ldpPos)
-        $ drawListYgapScaleYoff
-            (_ldpVerticalGap ldps)
-            (_ldpScale ldps)
+    translateScreenPos cfig (ldps ^. ldpPos) $
+        drawListYgapScaleYoff
+            (ldps ^. ldpVerticalGap)
+            (ldps ^. ldpScale)
             0
             (makeSelectionListPictures sl)
-            <> drawSelectionCursor sl ldps (CursorDisplay [North,West,South])
-
-drawSelectionCursor :: SelectionList a 
-    -> ListDisplayParams 
-    -> CursorDisplay 
-    -> Picture
-drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl)
-  where
-    -- the following is quite hacky
-    f = case sl ^. slRegex of
-        _ | sl ^. slRegexInput -> const (Just 0)
-        "" | not (sl ^. slRegexInput) -> id
-        _ -> fmap (+ 1)
+            <> drawCursorAt
+                (sl ^. slSelPos)
+                (sl ^. slItems)
+                ldps
+                (BoundaryCursor [North, South])
 
 makeSelectionListPictures :: SelectionList a -> [Picture]
-makeSelectionListPictures = concatMap f . getShownItems
+makeSelectionListPictures = concatMap f . _slItems
   where
     f si = map (color (_siColor si) . text) $ _siPictures si
-    --f si = map ((flip inverseText) ((_siColor si))) $ _siPictures si
 
-drawCursorAt :: Maybe Int -> [SelectionItem a] 
-    -> ListDisplayParams 
-    -> CursorDisplay
-    -> Picture
+drawCursorAt ::
+    Maybe Int ->
+    [SelectionItem a] ->
+    ListDisplayParams ->
+    CursorDisplay ->
+    Picture
 drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
     i <- mi
     selit <- lis !? i
@@ -67,7 +58,7 @@ drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
         listCursorChooseBorderScale
             (_ldpVerticalGap ldps)
             (_ldpScale ldps)
-            (curs ^. cursSides)
+            curs
             (sum . map _siHeight $ take i lis)
             (_siOffX selit)
             (_siColor selit)
@@ -76,8 +67,8 @@ drawCursorAt mi lis ldps curs = fromMaybe mempty $ do
 
 getLDPWidth :: ListDisplayParams -> Int
 getLDPWidth ldps = case _ldpWidth ldps of
-        FixedSelectionWidth x -> x
-        _ -> 1
+    FixedSelectionWidth x -> x
+    _ -> 1
 
 drawListYoff :: Int -> [Picture] -> Picture
 drawListYoff = drawListYgapScaleYoff 0 1
@@ -91,14 +82,14 @@ stackPicturesAt = stackPicturesAtOff 0
 stackPicturesAtOff :: Int -> [Picture] -> Picture
 stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
 
-selSecDrawCursorAt 
-    :: (Int,Int) 
-    -> Int 
-    -> ListDisplayParams 
-    -> CursorDisplay
-    -> SelectionSections a 
-    -> Picture
-selSecDrawCursorAt (i,j) xsize ldp curs sss = fromMaybe mempty $ do
+selSecDrawCursorAt ::
+    Int ->
+    ListDisplayParams ->
+    CursorDisplay ->
+    SelectionSections a ->
+    (Int, Int) ->
+    Picture
+selSecDrawCursorAt xsize ldp curs sss (i, j) = fromMaybe mempty $ do
     yint <- selSecYint i j sss
     xint <- sss ^? sssSections . ix i . ssIndent
     si <- sss ^? sssSections . ix i . ssItems . ix j
@@ -106,45 +97,48 @@ selSecDrawCursorAt (i,j) xsize ldp curs sss = fromMaybe mempty $ do
         listCursorChooseBorderScale
             (ldp ^. ldpVerticalGap)
             (ldp ^. ldpScale)
-            (curs ^. cursSides)
+            curs
             yint
             (xint + _siOffX si)
             (_siColor si)
             xsize
             (_siHeight si)
 
-selSecDrawCursor :: Int -> ListDisplayParams 
-    -> CursorDisplay
-    -> SelectionSections a -> 
-    Maybe (Int,Int) -> Picture
-selSecDrawCursor xsize ldp curs sss msel = maybe mempty 
-    (\x -> selSecDrawCursorAt x xsize ldp curs sss)
-    msel
+selSecDrawCursor ::
+    Int ->
+    ListDisplayParams ->
+    CursorDisplay ->
+    SelectionSections a ->
+    Maybe (Int, Int) ->
+    Picture
+selSecDrawCursor xsize ldp curs = maybe mempty . selSecDrawCursorAt xsize ldp curs
 
 -- displays a cursor that should match up to list text pictures
 listCursorChooseBorderScale ::
     Float ->
     Float ->
-    [CardinalPoint] ->
+    CursorDisplay ->
     Int ->
     Int ->
     Color ->
     Int ->
     Int ->
     Picture
-listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
+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) borders
+        $ chooseCursorBorders (s * wth) (s * hgt) curs
   where
     wth = 10 * (fromIntegral cursxsize + 1)
     hgt = 20 * fromIntegral cursysize + ygap * (fromIntegral cursysize - 1)
 
 -- note we cannot simply scale lines because they are drawn as solid rectangles
-chooseCursorBorders :: Float -> Float -> [CardinalPoint] -> Picture
-chooseCursorBorders w h = foldMap (line . toLine)
+chooseCursorBorders :: Float -> Float -> CursorDisplay -> Picture
+chooseCursorBorders w h = \case
+    BoundaryCursor ps -> foldMap (line . toLine) ps
+    BackdropCursor -> polygon . reverse $ rectNSWE 0 h' 0 w
   where
     h' = negate h
     toLine North = [V2 0 0, V2 w 0]
@@ -181,7 +175,7 @@ renderListAt :: Float -> Float -> [(String, Color)] -> Picture
 renderListAt tx ty = translate tx (- ty) . drawList . map (\(str, col) -> color col $ text str)
 
 --inverseText :: String -> Color -> Picture
---inverseText str col = 
+--inverseText str col =
 --    translate3 (V3 0 0 (0.5))
 --    (color (V4 0 1 0 0.1) ( text str))
 --    <>