Move towards separating selection sections cursor position storage

src/Dodge/Inventory.hs

@@ -226,10 +226,12 @@ scrollAugInvSel :: Int -> World -> World
 scrollAugInvSel yi w
     | yi == 0 = w
     | otherwise =
-        w & hud . hudElement . diSections %~ scrollSelectionSections yi
+        w & hud . hudElement . diSections %~ doscroll
             & worldEventFlags . at InventoryChange ?~ ()
             & setInvPosFromSS
             & cWorld . lWorld %~ crUpdateItemLocations 0
+  where
+    doscroll sss = sss & sssExtra . sssSelPos %~ scrollSelectionSections yi sss
 
 selectedCloseObject :: World -> Maybe (Either FloorItem Button)
 selectedCloseObject w = do

src/Dodge/SelectionSections.hs

@@ -13,22 +13,23 @@ module Dodge.SelectionSections (
     inverseSelBoundaryDown,
 ) where
 
-import Control.Monad
-import qualified Control.Foldl as L
-import Dodge.ScreenPos
-import Geometry.Data
-import Dodge.Data.Config
 import Control.Applicative
+import qualified Control.Foldl as L
 import Control.Lens
+import Control.Monad
 import qualified Data.IntMap.Strict as IM
 import Data.Maybe
+import Dodge.Data.Config
 import Dodge.Data.SelectionList
+import Dodge.ScreenPos
+import Geometry.Data
 
-scrollSelectionSections :: Int -> SelectionSections a -> SelectionSections a
+scrollSelectionSections :: Int -> SelectionSections a -> Maybe (Int,Int) 
-scrollSelectionSections yi sss
+    -> Maybe (Int,Int)
-    | yi == 0 = sss
+scrollSelectionSections yi sss msel
-    | yi > 0 = foldr ($) sss $ replicate yi (ssScrollUsing ssLookupUp)
+    | yi == 0 = msel
-    | otherwise = foldr ($) sss $ replicate (negate yi) (ssScrollUsing ssLookupDown)
+    | yi > 0 = foldr ($) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
+    | otherwise = foldr ($) msel $ replicate (negate yi) (ssScrollUsing ssLookupDown sss)
 
 setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
 setFirstPosSelectionSections sss = fromMaybe sss $ do
@@ -38,26 +39,28 @@ setFirstPosSelectionSections sss = fromMaybe sss $ do
 ssScrollUsing ::
     (Int -> Int -> SelectionSections a -> Maybe (Int, Int, SelectionItem a)) ->
     SelectionSections a ->
-    SelectionSections a
+    Maybe (Int,Int) ->
-ssScrollUsing g sss =
+    Maybe (Int,Int)
-    sss & sssExtra . sssSelPos
+ssScrollUsing g sss msel =
-        .~ fmap f (ssScrollSelectable g 
+         ( ssScrollMinOnFail
-                (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable)))
+                g
-  where
+                (sss & sssSections %~ fmap (ssItems %~ IM.filter _siIsSelectable))
-    f (i, j, _) = (i, j)
+                msel
+           )
 
-ssScrollSelectable ::
+ssScrollMinOnFail ::
     ( Int ->
       Int ->
       SelectionSections a ->
       Maybe (Int, Int, SelectionItem a)
     ) ->
     SelectionSections a ->
-    Maybe (Int, Int, SelectionItem a)
+    Maybe (Int, Int) ->
-ssScrollSelectable f sss = l <|> ssLookupMin sss
+    Maybe (Int, Int)
+ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin sss
   where
     l = do
-        (i, j) <- sss ^? sssExtra . sssSelPos . _Just
+        (i, j) <- msel
         f i j sss
 
 ssSetCursor ::
@@ -155,21 +158,26 @@ selSecYint i j sss = do
 
 -- it is annoying that Control.Foldl doesn't seem to allow for scans to be done
 -- at the same time as folds
-inverseSelSecYint :: Int -> SelectionSections a -> Maybe (Int,Int)
+inverseSelSecYint :: Int -> SelectionSections a -> Maybe (Int, Int)
-inverseSelSecYint yint sss = do 
+inverseSelSecYint yint sss = do
-    ((i,ss),othersss) <- IM.minViewWithKey (_sssSections sss)
+    ((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss)
     let l = length $ _ssShownItems ss
     if l <= yint
         then inverseSelSecYint (yint - l) (sss & sssSections .~ othersss)
         else do
             let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
             j <- L.fold (L.findIndex (\x -> x - _ssOffset ss > yint)) ls
-            return (i,j)
+            return (i, j)
 
-inverseSelSecYintXPosCheck :: Configuration -> ListDisplayParams 
+inverseSelSecYintXPosCheck ::
-    -> Float -> Int -> SelectionSections a -> Maybe (Int,Int)
+    Configuration ->
-inverseSelSecYintXPosCheck cfig ldp x yint sss = do 
+    ListDisplayParams ->
-    ((i,ss),othersss) <- IM.minViewWithKey (_sssSections sss)
+    Float ->
+    Int ->
+    SelectionSections a ->
+    Maybe (Int, Int)
+inverseSelSecYintXPosCheck cfig ldp x yint sss = do
+    ((i, ss), othersss) <- IM.minViewWithKey (_sssSections sss)
     let l = length $ _ssShownItems ss
         V2 x0 _ = screenPosAbs cfig (ldp ^. ldpPos)
     guard (x - x0 < 150) -- HACK, should determine selection item width and offset below
@@ -178,44 +186,42 @@ inverseSelSecYintXPosCheck cfig ldp x yint sss = do
         else do
             let ls = L.postscan (L.premap _siHeight L.sum) (_ssItems ss)
             j <- L.fold (L.findIndex (\val -> val - _ssOffset ss > yint)) ls
-            return (i,j)
+            return (i, j)
 
 inverseSelNumPos ::
     Configuration ->
     ListDisplayParams ->
     SelectionSections a ->
     Point2 ->
-    Maybe (Int,Int)
+    Maybe (Int, Int)
 inverseSelNumPos cfig ldp sss (V2 x y) =
     inverseSelSecYintXPosCheck cfig ldp x (posSelSecYint cfig ldp y) sss
 
-
+inverseSelBoundaryUp ::
-inverseSelBoundaryUp :: 
     Configuration ->
     ListDisplayParams ->
     SelectionSections a ->
     Point2 ->
-    Maybe (Int,Int)
+    Maybe (Int, Int)
-inverseSelBoundaryUp cfig ldp sss (V2 _ y)  = do
+inverseSelBoundaryUp cfig ldp sss (V2 _ y) = do
     sel <- inverseSelSecYint (posSelSecYint cfig ldp y) sss
     let mselup = inverseSelSecYint (posSelSecYint cfig ldp y - 1) sss
     if Just sel == mselup
         then return $ sel & _2 +~ 1
         else return $ sel
 
-inverseSelBoundaryDown :: 
+inverseSelBoundaryDown ::
     Configuration ->
     ListDisplayParams ->
     SelectionSections a ->
     Point2 ->
-    Maybe (Int,Int)
+    Maybe (Int, Int)
-inverseSelBoundaryDown cfig ldp sss (V2 _ y)  = do
+inverseSelBoundaryDown cfig ldp sss (V2 _ y) = do
     sel <- inverseSelSecYint (posSelSecYint cfig ldp y) sss
     let mseldown = inverseSelSecYint (posSelSecYint cfig ldp y + 1) sss
     if Just sel == mseldown
         then return $ sel & _2 -~ 1
         else return sel
 
-
 --getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
 --getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm

src/Dodge/Update/Scroll.hs

@@ -59,9 +59,11 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
 moveCombineSel :: Int -> World -> World
 moveCombineSel yi =
     ( hud . hudElement . subInventory . ciSections
-        %~ scrollSelectionSections yi
+        %~ doscroll
     )
         . (worldEventFlags . at CombineInventoryChange ?~ ())
+  where
+    doscroll sss = sss & sssExtra . sssSelPos %~ scrollSelectionSections yi sss
 
 --moveSubSel :: Int -> Int -> World -> World
 --moveSubSel yi maxyi =