Refactor inventory management, add tweak, combine and inspect modes

src/Dodge/Event.hs

@@ -46,31 +46,21 @@ handleEvent' e = case eventPayload e of
     _                           -> Just
 
 handleMouseMotionEvent :: MouseMotionEventData -> World -> Maybe World
-handleMouseMotionEvent mmev w
-    = Just $ w & mousePos .~ (fromIntegral x - 0.5*getWindowX w
-                             ,0.5*getWindowY w - fromIntegral y
-                             )
-    where P (V2 x y) = mouseMotionEventPos mmev
+handleMouseMotionEvent mmev w = Just $ w & mousePos .~ 
+    (fromIntegral x - 0.5*getWindowX w
+    ,0.5*getWindowY w - fromIntegral y
+    )
+  where 
+    P (V2 x y) = mouseMotionEventPos mmev
 
 handleMouseButtonEvent :: MouseButtonEventData -> World -> Maybe World
 handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of
-    Released -> Just    $ over mouseButtons (S.delete but) w
-    Pressed  -> handlePressedMouseButton but 
-                        $ over mouseButtons (S.insert but) w
-    where but = mouseButtonEventButton mbev
+    Released -> Just $ over mouseButtons (S.delete but) w
+    Pressed  -> handlePressedMouseButton but $ over mouseButtons (S.insert but) w
+  where 
+    but = mouseButtonEventButton mbev
 
-handleMouseWheelEvent :: MouseWheelEventData -> World -> Maybe World
-handleMouseWheelEvent mwev w = case _menuLayers w of
-    [] -> case mouseWheelEventPos mwev of
-        V2 _ y 
-            | y > 0      -> Just (wheelUpEvent w)
-            | y < 0      -> Just (wheelDownEvent w)
-            | otherwise  -> Just w
-    _ -> Just w
-
-{- |
-Resets the world window size, and resizes the fbo that gets the light map drawn into it.
- -}
+{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it.  -}
 handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World
 handleResizeEvent sev w = Just 
     . set (config . windowX) (fromIntegral x)
@@ -89,57 +79,41 @@ handlePressedMouseButton but w
                 = Just $ w & clickMousePos .~ _mousePos w
     | otherwise = Just w
 
-wheelUpEvent :: World -> World
-wheelUpEvent w = case _carteDisplay w of
-    True    
-        | rbDown    -> w & carteZoom .~ min 0.75 (z+(0.1*z))
-        | otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i - 1)
-    _       
-        | rbDown    -> fromMaybe (closeObjScrollUp w) 
-                            $ (yourItem w ^? itScrollUp) 
+handleMouseWheelEvent :: MouseWheelEventData -> World -> Maybe World
+handleMouseWheelEvent mwev w = case _menuLayers w of
+    [] -> case mouseWheelEventPos mwev of
+        V2 _ y -> Just $ wheelEvent (fromIntegral y) w
+    _ -> Just w
+
+wheelEvent :: Float -> World -> World
+wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
+    (True, _)
+        | rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
+        | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
+    (_, TopInventory)
+        | rbDown -> fromMaybe (closeObjScrollDir y w) $ (yourItem w ^? itScrollUp) 
                                 <*> pure (_crInvSel (you w))
                                 <*> pure w
-        | lbDown    -> w & cameraZoom +~ 0.1
-        | invKeyDown -> swapInvUp $ upInvPos w
-        | otherwise -> upInvPos w
-  where 
+        | lbDown -> w & cameraZoom +~ y
+        | invKeyDown -> swapInvDir yi $ dirInvPos yi w
+        | otherwise -> dirInvPos yi w
+    (_, TweakInventory) -> w
+    (_, _) -> w
+  where
+    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
-    z = _carteZoom w
-    numLocs = (fst . IM.findMax $ _seenLocations w) + 1
 
-wheelDownEvent :: World -> World
-wheelDownEvent w = case _carteDisplay w of
-    True    
-        | rbDown    -> w & carteZoom .~ max 0.05 (z-(0.1*z))
-        | otherwise -> w & selLocation %~ (`mod` numLocs) . (+ 1)
-    False   
-        | rbDown    -> fromMaybe (closeObjScrollDown w)
-            $ (yourItem w ^? itScrollDown) <*> pure (_crInvSel (you w)) <*> pure w
-        | lbDown     -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
-        | invKeyDown  -> downInvPos $ swapInvUp w
-        | otherwise   -> downInvPos w
-  where 
-    rbDown = ButtonRight `S.member` _mouseButtons w
-    lbDown = ButtonLeft `S.member` _mouseButtons w
-    z = _carteZoom w
-    invKeyDown = ScancodeCapsLock `S.member` _keys w
-    numLocs = (fst . IM.findMax $ _seenLocations w) + 1
-
-swapInvUp :: World -> World
-swapInvUp w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + 1) `mod` n)
+swapInvDir :: Int -> World -> World
+swapInvDir k w = w & creatures . ix (_yourID w) . crInv %~ IM.swapKeys (i `mod` n) ((i + k) `mod` n)
   where
     i = _crInvSel $ you w
     n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
 
-upInvPos :: World -> World
-upInvPos w = stopSoundFrom (CrReloadSound 0) $ w
-    & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract 1
-  where 
-    n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w
-downInvPos :: World -> World
-downInvPos w = stopSoundFrom (CrReloadSound 0) $ w
-    & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . (+ 1)
+dirInvPos :: Int -> World -> World
+dirInvPos i w =  stopSoundFrom (CrReloadSound 0) $ w
+    & creatures . ix (_yourID w) . crInvSel %~ (`mod` n) . subtract i
   where 
     n = length $ IM.keys $ _crInv $ _creatures w IM.! _yourID w