Reimplement combining items

src/Dodge/Creature/YourControl.hs

@@ -12,8 +12,6 @@ import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Test
 import Dodge.Data.World
 import Dodge.InputFocus
---import Dodge.LightSource
-import Dodge.Update.UsingInput
 import Geometry
 import LensHelp
 import qualified SDL

src/Dodge/Update/Input.hs

@@ -2,6 +2,8 @@ module Dodge.Update.Input (
     updateUseInput,
 ) where
 
+import Data.List (sort)
+import Dodge.Inventory.Add
 import Dodge.Data.Combine
 import Geometry
 import Dodge.SelectionList
@@ -55,7 +57,7 @@ updateUseInputInGame h u = case h of
                 u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmInput . tiFocus %~ const True
         CombineInventory _ _ sss
             | inSubInvRegex (u ^. uvWorld) -> doSubInvRegexInput u
-            | lbinitialpress -> tryCombine sss u -- maybeexitcombine (maybe id doCombine mi w)
+            | lbinitialpress -> maybeExitCombine $ over uvWorld (tryCombine sss) u -- maybeexitcombine (maybe id doCombine mi w)
         _ | inInvRegex (u ^. uvWorld) -> doRegexInput (-1) invRegex invRegex u
         _ | inCloseRegex (u ^. uvWorld) -> doRegexInput 2 closeRegex closeRegex u
         _ -> M.foldlWithKey' updateKeyInGame u pkeys
@@ -65,8 +67,17 @@ updateUseInputInGame h u = case h of
     pmb = u ^. uvWorld . input . mouseButtons
     lbinitialpress = pmb ^? ix ButtonLeft == Just False
 
-tryCombine :: SelectionSections CombinableItem -> Universe -> Universe
-tryCombine sss w = w
+tryCombine :: SelectionSections CombinableItem -> World -> World
+tryCombine sss w = fromMaybe w $ do
+    (i,j) <- sss ^? sssSelPos . _Just
+    CombinableItem is it _ <- sss ^? sssSections . ix i . ssItems . ix j . siPayload
+    return $ createAndSelectItem it $ foldr (rmInvItem 0) w (sort is)
+
+maybeExitCombine :: Universe -> Universe
+maybeExitCombine u
+    | ButtonRight `M.member` (u ^. uvWorld . input . mouseButtons)
+        = u
+    | otherwise = u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
 
 doTextInputOver :: ASetter' Universe String -> Universe -> Universe
 doTextInputOver p u =