Implement combining of items

src/Dodge/Event.hs

@@ -13,6 +13,7 @@ module Dodge.Event
     ( handleEvent
     ) where
 import Dodge.Event.Keyboard
+import Dodge.Combine
 --import Dodge.Event.Menu
 import Dodge.Data
 import Dodge.Base
@@ -21,10 +22,14 @@ import Dodge.PreloadData
 --import Dodge.Creature.Action
 import Dodge.SoundLogic
 import Dodge.Inventory
+import Dodge.Inventory.PickUp
 --import Geometry
 --import Preload.Update
 import qualified IntMapHelp as IM
+import ListHelp
+import Dodge.FloorItem
 
+--import Data.Monoid
 import Data.Maybe
 import Control.Lens
 --import Data.Maybe
@@ -92,8 +97,23 @@ handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe
 handlePressedMouseButton but w
     | but == ButtonMiddle || _carteDisplay (_uvWorld w) 
                 = Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
+    | but == ButtonLeft = case _inventoryMode (_uvWorld w) of
+        CombineInventory mi -> Just $ fromMaybe w $ do -- ugly
+            i <- mi
+            return $ over uvWorld (doCombine i) w
+        _ -> Just w
     | otherwise = Just w
 
+doCombine :: Int -> World -> World
+doCombine i w = case combineItemListYou w !? i of
+    Nothing -> w
+    Just (is,it) -> enterCombineInv
+        . uncurry (putItemInInvID yid)
+        . copyItemToFloorID (_crPos $ you w) it
+        $ foldr (rmInvItem yid) w is & enterCombineInv
+  where
+    yid = _yourID w
+
 handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe
 handleMouseWheelEvent mwev w = case _menuLayers w of
     [] -> case mouseWheelEventPos mwev of
@@ -117,14 +137,29 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
         | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
         | rbDown ->     w & changeTweakParam yi
         | otherwise ->  w & moveTweakSel yi
+    (_, CombineInventory _) -> w 
+        & inventoryMode . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
     (_, _) -> w
   where
+    numcombs = length $ combineListYou w
     yi = round $ signum y
     numLocs = (fst . IM.findMax $ _seenLocations w) + 1
     rbDown = ButtonRight `S.member` _mouseButtons w
     lbDown = ButtonLeft `S.member` _mouseButtons w
     invKeyDown = ScancodeCapsLock `S.member` _keys w
 
+-- nice idea, but the chain of setters and getters seems prohibitive
+--scrollOver :: Foldable t
+--    => ASetter s s Int Int  -- index setter
+--    -> Getting (First (t a)) s (t a) -- pointer to object of size
+--    -> Float -- direction
+--    -> s -> s
+--scrollOver theset theget y w = case w ^? theget of
+--    Just t  -> w & theset %~ ( (`mod` length t) . (subtract y'))
+--    Nothing -> w
+--  where
+--    y' = round $ signum y
+
 moveTweakSel :: Int -> World -> World
 moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
     Just l -> w & creatures . ix (_yourID w) . crInv . ix (_crInvSel (you w))