Improve scroll selection

src/Dodge/Inventory.hs

@@ -152,7 +152,10 @@ changeSwapSelSet yi w
 
 swapSelSet :: (Int -> IS.IntSet -> World -> World) -> World -> World
 swapSelSet f w = fromMaybe w $ do
-    Sel j _ is <- w ^. hud . diSelection
+    Sel j i is' <- w ^. hud . diSelection
+    let is = if IS.null is' 
+        then IS.singleton i
+        else is'
     return $
         if concurrentIS is
             then f j is w
@@ -224,7 +227,10 @@ multiSelScroll' f w = fromMaybe w $ do
     Sel j i is <- w ^. hud . diSelection
     ss <- w ^? hud . diSections . ix j . ssItems
     k <- f i ss
-    let insertordelete = if k `IS.member` is then IS.delete i else IS.insert i . IS.insert k
+    let insertordelete 
+            | not (i `IS.member` is) && k `IS.member` is = IS.delete k
+            | k `IS.member` is = IS.delete i 
+            | otherwise = IS.insert i . IS.insert k
     return $
         w
             & hud . diSelection . _Just . slSet %~ insertordelete

src/Dodge/SelectionSections.hs

@@ -41,21 +41,35 @@ ssScrollUsing ::
     Maybe Selection
 ssScrollUsing g = ssScrollMinOnFail g . fmap (ssItems %~ IM.filter _siIsSelectable)
 
+-- 
 ssScrollMinOnFail ::
     (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
     IMSS a ->
     Maybe Selection ->
     Maybe Selection
-ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLookupMin sss
+ssScrollMinOnFail f sss msel = fmap (\(i, j, _) -> Sel i j q) $ l <|> ssLookupMin sss
   where
-    q i j = fromMaybe mempty $ do
-        Sel k _ xs <- msel ^? _Just
-        guard $ j `IS.member` xs && i == k
-        return xs
+    q = fold (msel ^? _Just . slSet)
     l = do
         Sel i j _ <- msel
         f i j sss
 
+---- this version removes the selected set when scrolling outside it
+--ssScrollMinOnFail' ::
+--    (Int -> Int -> IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
+--    IMSS a ->
+--    Maybe Selection ->
+--    Maybe Selection
+--ssScrollMinOnFail' f sss msel = fmap (\(i, j, _) -> Sel i j (q i j)) $ l <|> ssLookupMin sss
+--  where
+--    q i j = fromMaybe mempty $ do
+--        Sel k _ xs <- msel ^? _Just
+--        guard $ j `IS.member` xs && i == k
+--        return xs
+--    l = do
+--        Sel i j _ <- msel
+--        f i j sss
+
 ssSetCursor ::
     (IMSS a -> Maybe (Int, Int, SelectionItem a)) ->
     IMSS a ->

src/Dodge/Update/Scroll.hs

@@ -29,15 +29,14 @@ updateWheelEvent yi w = case w ^. hud . subInventory of
 -- yi should be nonzero
 updateBaseWheelEvent :: Int -> World -> World
 updateBaseWheelEvent yi w
-    --    | Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w
     | Just True <- w ^? cWorld . lWorld . lInvLock = w
     | bdown ButtonRight = case _rbState w of
         EquipOptions{} -> w & rbState . opSel %~ scrollRBOption yi rbscrollmax
         NoRightButtonState -> fromMaybe w (selectedItemScroll yi w)
     | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
     | ScancodeCapsLock `M.member` _pressedKeys (_input w) 
-        , ScancodeLShift `M.member` (w ^. input . pressedKeys) = changeSwapSelSet yi w
-    | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
+        , ScancodeLShift `M.member` (w ^. input . pressedKeys) = changeSwapSel yi w
+    | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSelSet yi w
     | ScancodeLShift `M.member` (w ^. input . pressedKeys) = multiSelScroll yi w
     | otherwise = scrollAugInvSel yi w
   where