Work on inventory ui

src/Dodge/Data/HUD.hs

@@ -1,17 +1,17 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Dodge.Data.HUD where
 
-import Dodge.Data.Combine
-import Dodge.Data.SelectionList
-import Dodge.Data.Button
-import Dodge.Data.FloorItem
 import Control.Lens
-import Geometry.Data
 import Data.IntMap.Strict (IntMap)
+import Dodge.Data.Button
+import Dodge.Data.Combine
+import Dodge.Data.FloorItem
+import Dodge.Data.SelectionList
+import Geometry.Data
 
 data HUDElement
     = DisplayInventory
@@ -23,12 +23,13 @@ data HUDElement
 data SubInventory
     = NoSubInventory
     | ExamineInventory {_subInvMSel :: Maybe Int}
---    | CombineInventory {_subInvMap :: SelectionIntMap CombinableItem}
+    | CombineInventory
-    | CombineInventory {_ciCombinations :: IntMap (SelectionItem CombinableItem)
+        { _ciCombinations :: IntMap (SelectionItem CombinableItem)
         , _ciSections :: SelectionSections CombinableItem
         }
     | LockedInventory
     | DisplayTerminal {_termID :: Int}
+
 --    deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 data HUD = HUD
@@ -38,6 +39,7 @@ data HUD = HUD
     , _carteRot :: Float
     , _closeObjects :: [Either FloorItem Button]
     }
+
 --    deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
 makeLenses ''HUD

src/Dodge/ListDisplayParams.hs

@@ -33,21 +33,20 @@ invDisplayParams w =
         & ldpWidth .~ FixedSelectionWidth (determineInvSelCursorWidth w)
         & ldpPos . spPixelOff .~ V2 6 (-1)
   where
-    selcursortype
+    selcursortype = case w ^? hud . hudElement . subInventory of
-        | isexaminesub || ButtonRight `M.member` _mouseButtons (_input w) = [North, South, East, West]
+        _ | ButtonRight `M.member` _mouseButtons (_input w) -> [North, South, East, West]
-        | otherwise = [North, South, West]
+        Just ExamineInventory{} -> [North, South, East, West]
-    isexaminesub = case w ^? hud . hudElement . subInventory of
+        Just CombineInventory{} -> []
-        Just ExamineInventory{} -> True
+        _ -> [North, South, West]
-        _ -> False
 
 secondColumnParams :: ListDisplayParams
 secondColumnParams =
     defaultListDisplayParams
-        & ldpPos . spPixelOff .~ V2 subInvX (-71)
+        & ldpPos . spPixelOff .~ V2 subInvX (-81)
         & ldpCursorSides .~ [North, South, West]
 
 subInvX :: Float
-subInvX = 10 * fromIntegral topInvW + 50
+subInvX = 10 * fromIntegral topInvW + 70
 
 topInvW :: Int
 topInvW = 15

src/Dodge/Render/HUD.hs

@@ -3,7 +3,6 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
-import Dodge.Item.Display
 import Control.Lens
 import Control.Monad
 import qualified Data.Map.Strict as M
@@ -20,6 +19,7 @@ import Dodge.Data.World
 import Dodge.Default.SelectionList
 import Dodge.Equipment.Text
 import Dodge.Inventory
+import Dodge.Item.Display
 import Dodge.Item.Info
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
@@ -74,14 +74,14 @@ drawCombineInventory cfig sss w =
 drawExamineInventory :: Configuration -> Maybe Int -> World -> Picture
 drawExamineInventory cfig mtweaki w =
     invHead cfig "EXAMINE"
-        <> examineInventoryExtra mtweaki itm cfig
+        <> examineInventoryExtra mtweaki cfig
         <> drawSelectionList
             secondColumnParams
             cfig
-            ( defaultSelectionList & slItems .~ ammoTweakSelectionItems itm
+            ( defaultSelectionList & slItems .~ tweakItems itm
                 ++ map
                     f
-                    ( makeParagraph 60 $
+                    ( makeParagraph 55 $
                         yourAugmentedItem
                             itemInfo
                             (yourInfo (you w))
@@ -127,8 +127,8 @@ drawRBOptions cfig w = fromMaybe mempty $ do
     ae <- w ^? rbOptions . opAllocateEquipment
     sss <- w ^? hud . hudElement . diSections
     (i', j) <- sss ^? sssExtra . sssSelPos . _Just
-    curpos <- selSecSelPos i' j sss
+    curpos <- selSecYint i' j sss
-    let ytext = drawListElement 0 1 curpos . text
+    let ytext = drawListElement 0 1 0 curpos . text
         midstr = case ae of
             DoNotMoveEquipment -> ""
             PutOnEquipment{} -> "  PUT ON"
@@ -143,62 +143,71 @@ drawRBOptions cfig w = fromMaybe mempty $ do
                 "REMOVES " ++ otheritem rid
             _ -> ""
     return $
-        toTopLeft cfig
+        toTopLeft cfig $
-             $ translate 290 (-1) (ytext midstr)
+            translate 290 (-1) (ytext midstr)
                 <> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North, South] curpos 0 white 21 1)
-            <> translate 380 (-1) (drawListYoff (curpos - i) (map (text . eqPosText) es))
+                <> translate
-            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es))
+                    380
-            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i+1)))
+                    (-1)
-            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i)
+                    ( drawListYoff (curpos - i) (map (text . eqPosText) es)
-            <> translate 380 (-1) (maybetopborder i curpos)
+                        <> listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es)
-            <> translate 380 (-1) (maybebottomborder i (length es) curpos)
+                        <> listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i + 1))
+                        <> listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i
+                        <> maybetopborder i curpos
+                        <> maybebottomborder i (length es) curpos
+                    )
                 <> translate 460 (-1) (ytext extrastr)
   where
     maybetopborder 0 curpos = listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1
     maybetopborder _ _ = mempty
     maybebottomborder a b curpos
-        | a == b - 1
+        | a == b - 1 =
-                    = listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
+            listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
         | otherwise = mempty
     otheritem j = fromMaybe "" $ do
         itm <- you w ^? crInv . ix j
         return $ itemBaseName itm
 
-examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
+examineInventoryExtra :: Maybe Int -> Configuration -> Picture
-examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
+examineInventoryExtra mtweaki cfig = fromMaybe mempty $ do
     tweaki <- mtweaki
     -- consider moving this functionality out into a tweaks module
-    tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
+    --tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
     return $
         toTopLeft cfig $
-            translate subInvX (-60) $
+            translate subInvX (-71) $
-                listCursorNSW tweaki 0 white (length $ showTweak tparam) 15
+                --listCursorChooseBorderScale 0 1 [North,South,West] tweaki 0 white (length $ showTweak tparam) 1
+                listCursorChooseBorderScale 0 1 [North, South, West] tweaki 0 white 10 1
 
 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
 combineInventoryExtra sss cfig w = fromMaybe mempty $ do
     (i, j) <- sss ^? sssExtra . sssSelPos . _Just
+    cpos <- selSecYint i j sss
     si <- sss ^? sssSections . ix i . ssItems . ix j
-    cpos <- selSecSelPos i j sss
     let col = _siColor si
     return $
         mconcat
             [ fromMaybe mempty $ do
                 strs <- si ^? siPayload . ciInfo
-                return $ toTopLeft cfig (translate (subInvX + 150) 60 $ drawListYoff cpos $ map (color red . text) strs)
+                return
+                    . translate 160 0
+                    -- it would be better to get the width of the selection list from elsewhere
+                    . translateScreenPos cfig (secondColumnParams ^. ldpPos)
+                    $ drawListYoff cpos $ map (color red . text) strs
             , fromMaybe mempty $ do
                 lnks <- si ^? siPayload . ciInvIDs
                 return $
-                    lnkMidPosInvSelsCol cfig w cpos col lnks
+                    lnkMidPosInvSelsCol cfig w j col lnks
                         <> foldMap invcursor lnks
                         <> combineCounts cfig w lnks
             ]
   where
     invcursor i = fromMaybe mempty $ do
         sss' <- w ^? hud . hudElement . diSections
-        let idp = invDisplayParams w
+        let idp = (invDisplayParams w & ldpCursorSides .~ [North, South, East, West])
         return $
             translateScreenPos cfig (idp ^. ldpPos) $
-                selSecDrawCursor 17 [North, South, East] idp sss' 0 i
+                selSecDrawCursor 17 idp (sss' & sssExtra . sssSelPos ?~ (0, i))
 
 displayTerminal :: Int -> Configuration -> LWorld -> Picture
 displayTerminal tid cfig w = fromMaybe mempty $ do
@@ -231,9 +240,16 @@ combineCounts cfig w = foldMap f . group
     f (i : is) = fromMaybe mempty $ do
         _ <- yourInv w ^? ix i . itUse . useAmount
         sss <- w ^? hud . hudElement . diSections
-        p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
+        --p <- selNumTextEndPos cfig (invDisplayParams w) sss 0 i
         col <- selSecSelCol 0 i sss
-        return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
+        yint <- selSecYint 0 i sss
+        --return $ color col $ uncurryV translate p . scale 0.1 0.1 . text $ ('-' : show (length is + 1))
+        return
+            . translateScreenPos cfig (invDisplayParams w ^. ldpPos)
+            . color col
+            . drawListElement 0 1 15 yint
+            . text
+            $ ('-' : show (length is + 1))
     f _ = mempty
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
@@ -241,15 +257,14 @@ lnkMidPosInvSelsCol cfig w i col = foldMap f
   where
     f j = fromMaybe mempty $ do
         sss <- w ^? hud . hudElement . diSections
-        h <- selNumEndMidHeight cfig (invDisplayParams w) sss 0 j
+        combinesss <- w ^? hud . hudElement . subInventory . ciSections
+        lp <- selNumPos cfig (invDisplayParams w) sss 0 j
+        rp <- selNumPos cfig secondColumnParams combinesss 0 i
         invcol <- selSecSelCol 0 j sss
-        return $ zConnectCol rp (V2 18 0 + h) col white white invcol
+        return $ zConnectCol (rp - V2 5 0) (lp + V2 175 0) col white white invcol
-    rp = V2 (190 - hw) (hh - (20 * fromIntegral i + 77.5))
-    hh = halfHeight cfig
-    hw = halfWidth cfig
 
-ammoTweakSelectionItems :: Maybe Item -> [SelectionItem ()]
+tweakItems :: Maybe Item -> [SelectionItem ()]
-ammoTweakSelectionItems = textSelItems . ammoTweakStrings
+tweakItems = textSelItems . ammoTweakStrings
 
 ammoTweakStrings :: Maybe Item -> [String]
 ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of
@@ -261,7 +276,7 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
 
 invHead :: Configuration -> String -> Picture
 invHead cfig =
-    translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
+    translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 80))
         . dShadCol white
         . scale 0.4 0.4
         . textJustifyLeft
@@ -323,34 +338,22 @@ picsToSelectable pics =
         , _siPayload = ()
         }
 
--- there are still more ListDisplayParams to integrate here
+selNumPos ::
-selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
-selNumTextEndPos cfig ldp sss i j = do
-    ipos <- selSecSelPos i j sss
-    return $ V2 (150 - hw) (hh - ((s * 10 + ygap) * (fromIntegral ipos + 1)))
-  where
-    s = _ldpScale ldp
-    ygap = _ldpVerticalGap ldp
-    hh = halfHeight cfig
-    hw = halfWidth cfig
-
-selNumEndMidHeight ::
     Configuration ->
     ListDisplayParams ->
     SelectionSections a ->
     Int ->
     Int ->
     Maybe Point2
-selNumEndMidHeight cfig ldp sss i j = do
+selNumPos cfig ldp sss i j = do
-    ipos <- selSecSelPos i j sss
+    ipos <- selSecYint i j sss
     size <- selSecSelSize i j sss
-    --let bump = negate $ (10 * s + ygap) * fromIntegral size
+    return $
-    return $ V2 (150 - hw) (hh - ((10 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5)))
+        screenPosAbs cfig (ldp ^. ldpPos)
+            + V2 0 (negate (20 * s + ygap) * (fromIntegral ipos + fromIntegral size * 0.5))
   where
     s = _ldpScale ldp
     ygap = _ldpVerticalGap ldp
-    hh = halfHeight cfig
-    hw = halfWidth cfig
 
 selSecSelCol :: Int -> Int -> SelectionSections a -> Maybe Color
 selSecSelCol i j sss = sss ^? sssSections . ix i . ssItems . ix j . siColor

src/Dodge/Render/InfoBox.hs

@@ -3,6 +3,7 @@ module Dodge.Render.InfoBox
     , renderInfoListsAt
     ) where
 
+import Dodge.Data.CardinalPoint -- this should be imported implicitly
 import Dodge.Base
 import Dodge.Data.Camera
 import Dodge.Data.Config
@@ -15,7 +16,7 @@ renderInfoListAt :: Float -> Float -> Configuration -> Camera -> (Point2, [Strin
 renderInfoListAt x y cfig cam (p, ss) =
     toTopLeft cfig (renderListAt x y (zip ss (repeat white)))
         <> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
-        <> toTopLeft cfig (translate x (-y) $ listCursorNSW 0 0 white 19 (length ss))
+        <> toTopLeft cfig (translate x (-y) $ listCursorChooseBorderScale 0 1 [North,South] 0 0 white 19 (length ss))
   where
     hw = halfWidth cfig
     hh = halfHeight cfig

src/Dodge/Render/List.hs

@@ -1,6 +1,5 @@
 module Dodge.Render.List (
     renderListAt,
-    listCursorNSW,
     drawList,
     drawSelectionList,
     listPicturesYgapScaleYoff,
@@ -13,12 +12,12 @@ module Dodge.Render.List (
     listCursorChooseBorderScale,
 ) where
 
-import Dodge.ScreenPos
 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
@@ -30,40 +29,14 @@ drawSelectionList :: ListDisplayParams -> Configuration -> SelectionList a -> Pi
 drawSelectionList ldps cfig sl =
     translateScreenPos
         cfig
-        (ldps ^. ldpPos) $
+        (ldps ^. ldpPos)
-            listPicturesYgapScaleYoff
+        $ listPicturesYgapScaleYoff
             (_ldpVerticalGap ldps)
             (_ldpScale ldps)
             0
             (makeSelectionListPictures sl)
             <> drawSelectionCursor sl ldps
 
-makeSelectionListPictures :: SelectionList a -> [Picture]
-makeSelectionListPictures = concatMap f . getShownItems
-  where
-    f si = map (color (_siColor si) . text) $ _siPictures si
-
-drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
-drawCursorAt mi lis ldps = fromMaybe mempty $ do
-    i <- mi
-    selit <- lis !? i
-    let j = sum . map _siHeight $ take i lis
-        col = _siColor selit
-    return $
-        listCursorChooseBorderScale
-            (_ldpVerticalGap ldps)
-            (_ldpScale ldps)
-            (ldps ^. ldpCursorSides)
-            j
-            (_siOffX selit)
-            col
-            wdth
-            (_siHeight selit)
-  where
-    wdth = case _ldpWidth ldps of
-        FixedSelectionWidth x -> x
-        _ -> 1
-
 drawSelectionCursor :: SelectionList a -> ListDisplayParams -> Picture
 drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl)
   where
@@ -73,43 +46,61 @@ drawSelectionCursor sl = drawCursorAt (f $ sl ^. slSelPos) (getShownItems sl)
         "" | not (sl ^. slRegexInput) -> id
         _ -> fmap (+ 1)
 
+makeSelectionListPictures :: SelectionList a -> [Picture]
+makeSelectionListPictures = concatMap f . getShownItems
+  where
+    f si = map (color (_siColor si) . text) $ _siPictures si
+
+drawCursorAt :: Maybe Int -> [SelectionItem a] -> ListDisplayParams -> Picture
+drawCursorAt mi lis ldps = fromMaybe mempty $ do
+    i <- mi
+    selit <- lis !? i
+    return $
+        listCursorChooseBorderScale
+            (_ldpVerticalGap ldps)
+            (_ldpScale ldps)
+            (ldps ^. ldpCursorSides)
+            (sum . map _siHeight $ take i lis)
+            (_siOffX selit)
+            (_siColor selit)
+            (getLDPWidth ldps)
+            (_siHeight selit)
+
+getLDPWidth :: ListDisplayParams -> Int
+getLDPWidth ldps = case _ldpWidth ldps of
+        FixedSelectionWidth x -> x
+        _ -> 1
+
 drawListYoff :: Int -> [Picture] -> Picture
 drawListYoff = listPicturesYgapScaleYoff 0 1
 
 listPicturesYgapScaleYoff :: Float -> Float -> Int -> [Picture] -> Picture
-listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s) [i ..]
+listPicturesYgapScaleYoff ygap s i = mconcat . zipWith (drawListElement ygap s 0) [i ..]
 
 stackPicturesAt :: [Picture] -> Picture
 stackPicturesAt = stackPicturesAtOff 0
 
 stackPicturesAtOff :: Int -> [Picture] -> Picture
-stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1) [i, i -1 ..]
+stackPicturesAtOff i = mconcat . zipWith (drawListElement 10 1 0) [i, i -1 ..]
 
-selSecDrawCursor :: Int -> [CardinalPoint] -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Picture
+selSecDrawCursor :: Int -> ListDisplayParams -> SelectionSections a -> Picture
-selSecDrawCursor xsize borders ldp sss i j = fromMaybe mempty $ do
+selSecDrawCursor xsize ldp sss = fromMaybe mempty $ do
-    yint <- selSecSelPos i j sss
+    (i, j) <- sss ^? sssExtra . sssSelPos . _Just
+    yint <- selSecYint i j sss
     xint <- sss ^? sssSections . ix i . ssIndent
     si <- sss ^? sssSections . ix i . ssItems . ix j
-    return $ listCursorDisplayParams ldp borders yint xint (_siColor si) xsize (length $ _siPictures si)
+    return $
-
+        listCursorChooseBorderScale
-listCursorDisplayParams ::
+            (ldp ^. ldpVerticalGap)
-    ListDisplayParams ->
+            (ldp ^. ldpScale)
-    [CardinalPoint] ->
+            (ldp ^. ldpCursorSides)
-    Int ->
+            yint
-    Int ->
+            xint
-    Color ->
+            (_siColor si)
-    Int ->
+            xsize
-    Int ->
+            (length $ _siPictures si)
-    Picture
-listCursorDisplayParams ldp borders a b c d =
-    listCursorChooseBorderScale ygap s borders a b c d
-  where
-    ygap = _ldpVerticalGap ldp
-    s = _ldpScale ldp
 
 -- 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
 listCursorChooseBorderScale ::
     Float ->
     Float ->
@@ -130,11 +121,6 @@ listCursorChooseBorderScale ygap s borders yint xint col cursxsize cursysize =
     wth = 10 * (fromIntegral cursxsize + 1)
     hgt = 20 * fromIntegral cursysize + ygap * (fromIntegral cursysize - 1)
 
--- displays a cursor that should match up to list text pictures
-listCursorChooseBorder ::
-    [CardinalPoint] -> Int -> Int -> Color -> Int -> Int -> Picture
-listCursorChooseBorder = listCursorChooseBorderScale 10 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)
@@ -145,9 +131,6 @@ chooseCursorBorders w h = foldMap (line . toLine)
     toLine South = [V2 w h', V2 0 h']
     toLine West = [V2 0 h', V2 0 0]
 
-listCursorNSW :: Int -> Int -> Color -> Int -> Int -> Picture
-listCursorNSW a b c d = listCursorChooseBorder [North, South, West] a b c d
-
 --fillScreenText :: Configuration -> String -> Picture
 --fillScreenText cfig str =
 --    scale wscale hscale
@@ -168,9 +151,9 @@ listCursorNSW a b c d = listCursorChooseBorder [North, South, West] a b c d
 --    thescale = hw * 0.02 / fromIntegral (length str)
 --    hw = halfWidth cfig
 
-drawListElement :: Float -> Float -> Int -> Picture -> Picture
+drawListElement :: Float -> Float -> Int -> Int -> Picture -> Picture
-drawListElement ygap s yint =
+drawListElement ygap s xint yint =
-    translate 0 (negate ((s * 20 + ygap) * (fromIntegral yint + 1)))
+    translate (s * 10 * fromIntegral xint) (negate ((s * 20 + ygap) * (fromIntegral yint + 1)))
         . scale (s * 0.1) (s * 0.1)
 
 renderListAt :: Float -> Float -> [(String, Color)] -> Picture

src/Dodge/ScreenPos.hs

@@ -10,11 +10,10 @@ fromTopLeft :: Point2 -> ScreenPos
 fromTopLeft (V2 x y) = ScreenPos (V2 (-0.5) 0.5) (V2 x (- y))
 
 translateScreenPos :: Configuration -> ScreenPos -> Picture -> Picture
-translateScreenPos cfig sp = translate x y
+translateScreenPos cfig = uncurryV translate . screenPosAbs cfig
-  where
-    V2 x y = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff
-    w = fromIntegral $ cfig ^. windowX
-    h = fromIntegral $ cfig ^. windowY
 
 screenPosAbs :: Configuration -> ScreenPos -> Point2
-screenPosAbs = undefined
+screenPosAbs cfig sp = sp ^. spScreenOff * V2 w h + sp ^. spPixelOff
+  where
+    w = fromIntegral $ cfig ^. windowX
+    h = fromIntegral $ cfig ^. windowY

src/Dodge/SelectionList.hs

@@ -1,4 +1,7 @@
-module Dodge.SelectionList where
+module Dodge.SelectionList (
+    getShownItems,
+    getAvailableListLines,
+) where
 
 import Color
 import Data.Maybe

src/Dodge/SelectionSections.hs

@@ -4,7 +4,7 @@ module Dodge.SelectionSections (
     ssLookupGT,
     ssSetCursor,
     setFirstPosSelectionSections,
-    selSecSelPos,
+    selSecYint,
     selSecSelSize,
 ) where
 
@@ -124,8 +124,8 @@ ssLookupGE' i sss = do
 selSecSelSize :: Int -> Int -> SelectionSections a -> Maybe Int
 selSecSelSize i j sss = fmap length $ sss ^? sssSections . ix i . ssItems . ix j . siPictures
 
-selSecSelPos :: Int -> Int -> SelectionSections a -> Maybe Int
+selSecYint :: Int -> Int -> SelectionSections a -> Maybe Int
-selSecSelPos i j sss = do
+selSecYint i j sss = do
     ss <- sss ^? sssSections . ix i
     return . (secpos +)
         . subtract (ss ^. ssOffset)

src/Dodge/SelectionSections/Draw.hs

@@ -1,25 +1,20 @@
 module Dodge.SelectionSections.Draw where
 
-import Dodge.ScreenPos
 import Control.Lens
-import Data.Maybe
-import Dodge.Data.CardinalPoint
 import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Render.List
+import Dodge.ScreenPos
 import Picture.Base
 
 drawSelectionSections :: SelectionSections a -> ListDisplayParams -> Configuration -> Picture
-drawSelectionSections sss ldps cfig =
+drawSelectionSections sss ldp cfig =
-    translateScreenPos cfig (ldps ^. ldpPos) $
+    translateScreenPos cfig (ldp ^. ldpPos) $
         listPicturesYgapScaleYoff
-            (_ldpVerticalGap ldps)
+            (_ldpVerticalGap ldp)
-            (_ldpScale ldps)
+            (_ldpScale ldp)
             0
             pics
-            <> thecursor'
+            <> selSecDrawCursor 15 ldp sss
   where
-    thecursor' = fromMaybe mempty $ do
-        (i, j) <- sss ^? sssExtra . sssSelPos . _Just
-        return $ selSecDrawCursor 15 [North, South, West] ldps sss i j
     pics = foldMap _ssShownItems (_sssSections sss)