Allow scrolling within a larger selection to not remove larger selection

src/Dodge/SelectionSections.hs

@@ -10,6 +10,7 @@ module Dodge.SelectionSections (
     inverseSelNumPos,
 ) where
 
+import qualified Data.IntSet as IS
 import Control.Applicative
 import qualified Control.Foldl as L
 import Control.Lens
@@ -25,8 +26,8 @@ import Geometry.Data
 scrollSelectionSections ::
     Int ->
     IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int) ->
-    Maybe (Int, Int)
+    Maybe (Int, Int,IS.IntSet) ->
+    Maybe (Int, Int,IS.IntSet)
 scrollSelectionSections yi sss msel
     | yi == 0 = msel
     | yi > 0 = foldl' (&) msel $ replicate yi (ssScrollUsing ssLookupUp sss)
@@ -34,8 +35,8 @@ scrollSelectionSections yi sss msel
 
 nextInSectionSS :: 
     IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int) ->
-    Maybe (Int, Int)
+    Maybe (Int, Int, IS.IntSet) ->
+    Maybe (Int, Int, IS.IntSet)
 nextInSectionSS = ssScrollUsing ssLookupNextMax
 
 --setFirstPosSelectionSections :: SelectionSections a -> SelectionSections a
@@ -46,8 +47,8 @@ nextInSectionSS = ssScrollUsing ssLookupNextMax
 ssScrollUsing ::
     (Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
     IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int) ->
-    Maybe (Int, Int)
+    Maybe (Int, Int, IS.IntSet) ->
+    Maybe (Int, Int, IS.IntSet)
 ssScrollUsing g =
     ssScrollMinOnFail
         g
@@ -56,22 +57,30 @@ ssScrollUsing g =
 ssScrollMinOnFail ::
     (Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
     IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int) ->
-    Maybe (Int, Int)
-ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j)) $ l <|> ssLookupMin sss
+    Maybe (Int, Int, IS.IntSet) ->
+    Maybe (Int, Int, IS.IntSet)
+ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> (i, j, q i j)) $ l <|> ssLookupMin sss
   where
+    q i j = fromMaybe mempty $ do
+        (k,_,xs) <- msel ^? _Just
+        guard $ j `IS.member` xs && i == k
+        return xs
     l = do
-        (i, j) <- msel
+        (i, j, _) <- msel
         f i j sss
 
 ssSetCursor ::
     (IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)) ->
     IM.IntMap (SelectionSection a) ->
-    Maybe (Int, Int) ->
-    Maybe (Int, Int)
+    Maybe (Int, Int, IS.IntSet) ->
+    Maybe (Int, Int, IS.IntSet)
 ssSetCursor f sss msel = fromMaybe msel $ do
     (i, j, _) <- f sss
-    return $ Just (i, j)
+    let newxs = fromMaybe mempty $ do
+            (k,_,xs) <- msel
+            guard $ k == i && j `IS.member` xs
+            return xs
+    return $ Just (i, j,newxs)
 
 ssLookupMax :: IM.IntMap (SelectionSection a) -> Maybe (Int, Int, SelectionItem a)
 ssLookupMax sss = do