Start simplifying mouse inventory selection

src/Dodge/Update.hs

@@ -305,21 +305,21 @@ updateMouseInventorySelection' sss cfig w
     | leftclickstart = case msel of
         Nothing -> fromMaybe w $ do
             ysel <- mysel
-            return $ w & hud . hudElement . subInventory . nsSelected .~ MouseInvSelect ysel Nothing
-        Just p -> w & hud . hudElement . subInventory . nsSelected %~ startdrag p
+            return $ w & hud . hudElement . subInventory . nsSelected 
+                .~ MouseInvSelect ysel Nothing
+        Just p -> startDrag p w
     | leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
         Just MouseInvSelect{} ->
-            w
-                & hud . hudElement . subInventory . nsSelected . misMaybeEnd .~ msel
-        Just (MouseInvChosen ssel esel)
-            | maybe False (< ssel) $ inverseSelBoundaryUp cfig ldp sss mpos ->
-                w
-                    & shiftInvItemsUp ssel esel (inverseSelBoundaryUp cfig ldp sss mpos)
-        Just (MouseInvChosen ssel esel)
-            | maybe False (> esel) $ inverseSelBoundaryDown cfig ldp sss mpos ->
-                w
-                    & shiftInvItemsDown ssel esel (inverseSelBoundaryDown cfig ldp sss mpos)
-        Just (MouseInvChosen{}) -> w
+            w & hud . hudElement . subInventory . nsSelected . misMaybeEnd .~ msel
+        Just (MouseInvChosen x) -> shiftInvItems x w
+--            | maybe False (< ssel) $ inverseSelBoundaryUp cfig ldp sss mpos ->
+--                w
+--                    & shiftInvItemsUp ssel esel (inverseSelBoundaryUp cfig ldp sss mpos)
+--        Just (MouseInvChosen ssel esel)
+--            | maybe False (> esel) $ inverseSelBoundaryDown cfig ldp sss mpos ->
+--                w
+--                    & shiftInvItemsDown ssel esel (inverseSelBoundaryDown cfig ldp sss mpos)
+--        Just (MouseInvChosen{}) -> w
         _ ->
             w
                 & hud . hudElement . subInventory . nsSelected .~ NoMouseSel
@@ -327,16 +327,13 @@ updateMouseInventorySelection' sss cfig w
         Just (MouseInvSelect ssel (Just esel)) ->
             w
                 & hud . hudElement . subInventory . nsSelected
-                    .~ MouseInvChosen
-                        (min ssel esel)
-                        (max ssel esel)
+                  .~ MouseInvChosen (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
+                & augInvDirectSelect (min ssel esel)
         Just (MouseInvSelect _ Nothing) ->
             w
                 & hud . hudElement . subInventory . nsSelected .~ NoMouseSel
         _ -> w
   where
-    startdrag p (MouseInvChosen s e) | s <= p && p <= e = MouseInvChosen s e
-    startdrag p _ = MouseInvChosen p p
     leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0 && nobuttonright
     leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons) && nobuttonright
     nobuttonright = not $ ButtonRight `M.member` (w ^. input . mouseButtons)
@@ -345,27 +342,41 @@ updateMouseInventorySelection' sss cfig w
     msel = inverseSelNumPos cfig ldp sss (w ^. input . mousePos)
     mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
 
-shiftInvItemsUp :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
-shiftInvItemsUp (_, i) (_, j) Just{} w =
-    w
-        & flip (foldl' f) [i .. j]
-        & hud . hudElement . subInventory . nsSelected . misChosenStart . _2 -~ 1
-        & hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 -~ 1
+startDrag :: (Int,Int) -> World -> World
+startDrag (a,b) w = fromMaybe (augInvDirectSelect (a,b) $ setmichosen 0 w) $ do
+    (i,j) <- w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just
+    x <- w ^? hud . hudElement . subInventory . nsSelected . misExtra
+    guard $ i == a && b >= j && b <= j + x
+    return w
   where
-    f w' i' = swapInvItems g i' w'
-    g i' m = fmap fst $ IM.cycleLT i' m
-shiftInvItemsUp _ _ Nothing w = w
+    setmichosen x = hud . hudElement . subInventory . nsSelected .~ MouseInvChosen x
+    
+--     & hud . hudElement . subInventory . nsSelected %~ startdrag p
 
-shiftInvItemsDown :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
-shiftInvItemsDown (_, i) (_, j) Just{} w =
-    w
-        & flip (foldl' f) (reverse [i .. j])
-        & hud . hudElement . subInventory . nsSelected . misChosenStart . _2 +~ 1
-        & hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 +~ 1
-  where
-    f w' i' = swapInvItems g i' w'
-    g i' m = fmap fst $ IM.cycleGT i' m
-shiftInvItemsDown _ _ Nothing w = w
+shiftInvItems :: Int -> World -> World
+shiftInvItems x w = w
+
+--shiftInvItemsUp :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
+--shiftInvItemsUp (_, i) (_, j) Just{} w =
+--    w
+--        & flip (foldl' f) [i .. j]
+--        & hud . hudElement . subInventory . nsSelected . misChosenStart . _2 -~ 1
+--        & hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 -~ 1
+--  where
+--    f w' i' = swapInvItems g i' w'
+--    g i' m = fmap fst $ IM.cycleLT i' m
+--shiftInvItemsUp _ _ Nothing w = w
+--
+--shiftInvItemsDown :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
+--shiftInvItemsDown (_, i) (_, j) Just{} w =
+--    w
+--        & flip (foldl' f) (reverse [i .. j])
+--        & hud . hudElement . subInventory . nsSelected . misChosenStart . _2 +~ 1
+--        & hud . hudElement . subInventory . nsSelected . misChosenEnd . _2 +~ 1
+--  where
+--    f w' i' = swapInvItems g i' w'
+--    g i' m = fmap fst $ IM.cycleGT i' m
+--shiftInvItemsDown _ _ Nothing w = w
 
 updateMouseOverInventory :: Configuration -> World -> World
 updateMouseOverInventory cfig w = fromMaybe w $ do