From 79b03ef6ec3d5535fc97c532832ea06b8786c68a Mon Sep 17 00:00:00 2001
From: justin <justin.g.kruger@gmail.com>
Date: Tue, 5 Nov 2024 19:48:55 +0000
Subject: [PATCH] Fix connecting sounds

---
 ghcidOutput            | 11 +++++++++-
 src/Dodge/Inventory.hs | 50 ++++++++++++++++++++++++++++++++++--------
 2 files changed, 51 insertions(+), 10 deletions(-)

diff --git a/ghcidOutput b/ghcidOutput
index 6c826e637..480a3bd26 100644
--- a/ghcidOutput
+++ b/ghcidOutput
@@ -1 +1,10 @@
-All good (594 modules, at 19:11:58)
+/home/justin/Haskell/loop/src/Dodge/Inventory.hs:250:1-16: warning: [-Wunused-top-binds]
+    Defined but not used: ‘isConnectedAbove’
+    |
+250 | isConnectedAbove x = case x ^. locLdtContext of
+    | ^^^^^^^^^^^^^^^^
+/home/justin/Haskell/loop/src/Dodge/Inventory.hs:255:1-16: warning: [-Wunused-top-binds]
+    Defined but not used: ‘isConnectedBelow’
+    |
+255 | isConnectedBelow x = case x ^. locLdtContext of
+    | ^^^^^^^^^^^^^^^^
diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs
index 2897623ff..576c4d5f4 100644
--- a/src/Dodge/Inventory.hs
+++ b/src/Dodge/Inventory.hs
@@ -17,6 +17,10 @@ module Dodge.Inventory (
     isFilteringInv,
 ) where
 
+import Control.Monad
+import Dodge.Item.Grammar
+import Dodge.Data.DoubleTree
+import Sound.Data
 import Dodge.SoundLogic
 import Control.Applicative
 import Data.Maybe
@@ -190,7 +194,8 @@ swapInvItems f i w = fromMaybe w $ do
             _ -> id
     return $
         w 
-            & checkconnect k InventorySound disconnectItemS
+            -- & checkconnect k InventorySound disconnectItemS
+            & checkConnection InventorySound disconnectItemS i k
             & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
             & updateselection
             & worldEventFlags . at InventoryChange ?~ ()
@@ -198,15 +203,16 @@ swapInvItems f i w = fromMaybe w $ do
             & setInvPosFromSS
             & cWorld . lWorld %~ crUpdateItemLocations 0 -- the double application is inefficient, but necessary without further changes
             -- a rethink is maybe in order
-            & checkconnect k InventoryConnectSound connectItemS
+            & checkConnection InventoryConnectSound connectItemS i k
+           -- & checkconnect k InventoryConnectSound connectItemS
   where
-    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
+--    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)
@@ -224,6 +230,32 @@ swapInvItems f i w = fromMaybe w $ do
         Just epos -> crHotkeys . ix epos .~ b
         Nothing -> id
 
+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
+
+isConnectedAbove :: LocationLDT b a -> Bool
+isConnectedAbove x = case x ^. locLdtContext of
+    LeftwardLDT {} -> True
+    _ -> not . null $ x ^. locLDT . ldtRight
+    
+isConnectedBelow :: LocationLDT b a -> Bool
+isConnectedBelow x = case x ^. locLdtContext of
+    RightwardLDT {} -> True
+    _ -> not . null $ x ^. locLDT . ldtLeft
+
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w = case w ^? hud . hudElement . diSelection . _Just of
     Just (0, i) -> w & swapInvItems f i