Reimplement dragging upwards with mouse

src/Dodge/Update.hs

@@ -292,7 +292,8 @@ checkTermDist w = fromMaybe w $ do
     btid <- w ^? cWorld . lWorld . terminals . ix tmid . tmButtonID
     btpos <- w ^? cWorld . lWorld . buttons . ix btid . btPos
     guard $ dist btpos (_crPos $ you w) > 40
-    return (w & hud . hudElement . subInventory .~ NoSubInventory NoMouseSel Nothing)
+    return $ w & hud . hudElement . subInventory 
+        .~ NoSubInventory MouseInvNothing Nothing
 
 updateMouseInventorySelection :: Configuration -> World -> World
 updateMouseInventorySelection cfig w = fromMaybe w $ do
@@ -311,28 +312,19 @@ updateMouseInventorySelection' sss cfig w
     | leftclickheld = case w ^? hud . hudElement . subInventory . nsSelected of
         Just MouseInvSelect{} ->
             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
+        Just MouseInvDrag -> fromMaybe w $ do
+            sel <- w ^? hud . hudElement . diSelection . _Just
+            return $ w & shiftInvItems sel cfig mpos ldp sss
+        _ -> w
     | otherwise = case w ^? hud . hudElement . subInventory . nsSelected of
         Just (MouseInvSelect ssel (Just esel)) ->
-            w
-                & hud . hudElement . subInventory . nsSelected
-                  .~ MouseInvChosen (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
+            w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
+                & hud . hudElement . diSelectionExtra 
+                    .~ (max (snd ssel) (snd esel) - min (snd ssel) (snd esel))
                 & augInvDirectSelect (min ssel esel)
         Just (MouseInvSelect _ Nothing) ->
-            w
-                & hud . hudElement . subInventory . nsSelected .~ NoMouseSel
-        _ -> w
+            w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
+        _ -> w & hud . hudElement . subInventory . nsSelected .~ MouseInvNothing
   where
     leftclickstart = w ^? input . mouseButtons . ix ButtonLeft == Just 0 && nobuttonright
     leftclickheld = ButtonLeft `M.member` (w ^. input . mouseButtons) && nobuttonright
@@ -345,16 +337,31 @@ updateMouseInventorySelection' sss cfig w
 startDrag :: (Int,Int) -> World -> World
 startDrag (a,b) w = fromMaybe (augInvDirectSelect (a,b) $ setmichosen 0 w) $ do
     (i,j) <- w ^? hud . hudElement . diSelection . _Just
-    x <- w ^? hud . hudElement . subInventory . nsSelected . misExtra
+    x <- w ^? hud . hudElement . diSelectionExtra
     guard $ i == a && b >= j && b <= j + x
-    return w
+    return $ setmichosen x w
   where
-    setmichosen x = hud . hudElement . subInventory . nsSelected .~ MouseInvChosen x
-    
---     & hud . hudElement . subInventory . nsSelected %~ startdrag p
+    setmichosen x = (hud . hudElement . subInventory . nsSelected .~ MouseInvDrag)
+        . (hud . hudElement . diSelectionExtra .~ x)
 
-shiftInvItems :: Int -> World -> World
-shiftInvItems x w = w
+shiftInvItems :: (Int,Int) -> Configuration -> Point2 
+    -> ListDisplayParams
+    -> SelectionSections a 
+    -> World
+    -> World
+shiftInvItems topsel cfig mpos ldp sss w = case inverseSelBoundaryUp cfig ldp sss mpos of
+        Just p | p < topsel -> shiftInvItemsUp sss topsel w
+        _ -> w
+  where
+    mysel = inverseSelSecYint (posSelSecYint cfig ldp (mpos ^. _y)) sss
+
+shiftInvItemsUp :: SelectionSections a -> (Int,Int) -> World -> World
+shiftInvItemsUp sss (_,i) w = fromMaybe w $ do
+    x <- w ^? hud . hudElement . diSelectionExtra
+    return $ foldl' f w [i..i+x]  
+  where
+    f w' i' = swapInvItems g i' w'
+    g i' m = fmap fst $ IM.cycleLT i' m
 
 --shiftInvItemsUp :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int) -> World -> World
 --shiftInvItemsUp (_, i) (_, j) Just{} w =