Improve item pickup by dragging

src/Dodge/Inventory.hs

@@ -16,12 +16,10 @@ module Dodge.Inventory (
     swapItemWith,
 ) where
 
-import Control.Monad
+import Dodge.Inventory.Swap
 import Data.Function
-import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base
-import Dodge.Data.DoubleTree
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.Euse
@@ -29,17 +27,12 @@ import Dodge.Inventory.CheckSlots
 import Dodge.Inventory.Location
 import Dodge.Inventory.RBList
 import Dodge.ItEffect
-import Dodge.Item.Grammar
 import Dodge.SelectionSections
-import Dodge.SoundLogic
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
 import ListHelp
 import NewInt
-import Sound.Data
-
---import Padding
 
 -- TODO check what happens to selection index when dropping non-selected items
 
@@ -176,83 +169,6 @@ changeSwapOther manlens n f i w = fromMaybe w $ do
             & hud . hudElement . diSelection . _Just . _2 %~ doswap
             & worldEventFlags . at InventoryChange ?~ ()
 
--- can be specialised for when we know that item i is selected
-swapInvItems ::
-    (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->
-    Int ->
-    World ->
-    World
-swapInvItems f i w = fromMaybe w $ do
-    ss <- w ^? hud . hudElement . diSections . ix 0 . ssItems
-    k <- f i ss
-    let updateselection = case w ^? hud . hudElement . diSelection . _Just of
-            Just (0, j) | j == k -> hud . hudElement . diSelection . _Just . _2 .~ i
-            Just (0, j) | j == i -> hud . hudElement . diSelection . _Just . _2 .~ k
-            _ -> id
-    return $
-        w
-            & swapAnyExtraSelection i k
-            & checkConnection InventorySound disconnectItemS i k
-            & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
-            & updateselection
-            & worldEventFlags . at InventoryChange ?~ ()
-            & cWorld . lWorld %~ crUpdateItemLocations 0
-            & setInvPosFromSS
-            & cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
-            -- a rethink is maybe in order
-            & checkConnection InventoryConnectSound connectItemS i k
-  where
-    -- & checkconnect k InventoryConnectSound connectItemS
-
-    --    cpos = fromMaybe 0 $ w ^? cWorld . lWorld . creatures . ix 0 . crPos
-    --    checkconnect k stype s w'
-    --        | p (i+1) || p (i-1)
-    --            || p (k+1) || p (k-1) = soundStart stype cpos s Nothing w'
-    --        | otherwise = w'
-    --      where
-    --        p j = maybe False not $ w' ^? cWorld . lWorld . creatures . ix 0 . crInv . ix j . itLocation . ilIsRoot
-    updatecreature k =
-        (crInv %~ IM.safeSwapKeys i k)
-            . (crManipulation . manObject . imSelectedItem .~ k)
-            . (crInvEquipped %~ IM.safeSwapKeys i k)
-            . swapSite i k
-            . swapSite k i
-            . (crInvHotkeys %~ IM.safeSwapKeys i k)
-            . swapSite' i k
-            . swapSite' k i
-    cr = you w
-    swapSite a b = case cr ^? crInvEquipped . ix a of
-        Just epos -> crEquipment . ix epos .~ b
-        Nothing -> id
-    swapSite' a b = case cr ^? crInvHotkeys . ix a of
-        Just epos -> crHotkeys . ix epos .~ b
-        Nothing -> id
-
-swapAnyExtraSelection :: Int -> Int -> World -> World
-swapAnyExtraSelection i k w = fromMaybe w $ do
-    is <- w ^? hud . hudElement . diSelectionExtra
-    let f = if i `IS.member` is then IS.insert k else id
-        g = if k `IS.member` is then IS.insert i else id
-    return $
-        w & hud . hudElement . diSelectionExtra
-            %~ (f . g . IS.delete i . IS.delete k)
-
-checkConnection :: SoundOrigin -> SoundID -> Int -> Int -> World -> World
-checkConnection so s i j w = fromMaybe w $ do
-    inv <- w ^? cWorld . lWorld . creatures . ix 0 . crInv
-    cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
-    let locs = allInvLocs inv
-    iit <- locs ^? ix i . _2
-    jit <- locs ^? ix j . _2
-    guard $ isConnected iit || isConnected jit
-    return $ soundStart so cpos s Nothing w
-
-isConnected :: LocationLDT b a -> Bool
-isConnected x = case x ^. locLdtContext of
-    TopLDT ->
-        not (null $ x ^. locLDT . ldtRight)
-            || not (null $ x ^. locLDT . ldtLeft)
-    _ -> True
 
 swapItemWith ::
     (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) ->