Cleanup, delete hotkeys when deleting item from inventory

src/Dodge/Creature/Impulse/UseItem.hs

@@ -13,14 +13,12 @@ import Dodge.Data.World
 import Dodge.DoubleTree
 import Dodge.Euse
 import Dodge.HeldUse
---import Dodge.Hotkey
 import Dodge.Inventory
 import Dodge.Item.Grammar
---import Dodge.Item.Location
 import qualified IntMapHelp as IM
 
-useItem :: Int -> PressType -> World -> World
-useItem invid pt w = (worldEventFlags . at InventoryChange ?~ ()) . fromMaybe w $ do
+useItem :: Int -> PressType -> World -> Maybe World
+useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do
     cr <- w ^? cWorld . lWorld . creatures . ix 0
     itmloc <- allInvLocs (_crInv cr) ^? ix invid . _2
     let usedloc = useLocation itmloc
@@ -90,7 +88,6 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInv . ix invid . itLocation . ilEquipSite ?~ newp
             & onequip itm cr
-    --            & cWorld . lWorld %~ assignNewHotkey invid
     MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
@@ -109,16 +106,12 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
             & crpoint . crInv . ix rid . itLocation . ilEquipSite .~ Nothing
             & onremove (itmat rid) cr
             & onequip itm cr
-    --            & cWorld . lWorld %~ removeHotkey rid
-    --            & cWorld . lWorld %~ assignNewHotkey invid
     RemoveEquipment{_allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInv . ix invid . itLocation . ilEquipSite .~ Nothing
             & onremove itm cr
   where
-    --            & cWorld . lWorld %~ removeHotkey invid
-
     crpoint = cWorld . lWorld . creatures . ix (_crID cr)
     itmat i = _crInv cr IM.! i
     itm = itmat itRef

src/Dodge/Creature/YourControl.hs

@@ -2,7 +2,7 @@ module Dodge.Creature.YourControl (
     yourControl,
 ) where
 
-import Dodge.Inventory
+import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
@@ -12,6 +12,7 @@ import Dodge.Creature.Impulse.UseItem
 import Dodge.Data.World
 import Dodge.Hotkey
 import Dodge.InputFocus
+import Dodge.Inventory
 import Dodge.WASD
 import Geometry
 import LensHelp
@@ -25,8 +26,8 @@ yourControl _ w
     | Just NoSubInventory{} <- w ^? hud . hudElement . subInventory =
         w
             & cWorld . lWorld . creatures . ix 0
-                %~ (wasdWithAiming w . mouseActionsCr pkeys)
-            & pressedMBEffectsTopInventory pkeys
+                %~ (wasdWithAiming w . setCrPosture pkeys)
+            & tryClickUse pkeys
             & handleHotkeys
     | otherwise =
         w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
@@ -36,17 +37,17 @@ yourControl _ w
 handleHotkeys :: World -> World
 handleHotkeys w
     | SDL.ScancodeLShift `M.member` _pressedKeys (_input w)
-        || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) = fromMaybe w $ do
-        let hks = mapMaybe scancodeToHotkey $ M.keys $ w ^. input . pressedKeys
-        invid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
-        itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itID
-        return $ w & cWorld . lWorld %~ \lw -> foldl' (flip $ assignHotkey itid) lw hks
+        || SDL.ScancodeRShift `M.member` _pressedKeys (_input w)
+      , hks <- mapMaybe scancodeToHotkey $ M.keys $ w ^. input . pressedKeys
+      , Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
+      , Just itid <- lw ^? creatures . ix 0 . crInv . ix invid . itID =
+        w & cWorld . lWorld %~ \lw' -> foldl' (flip $ assignHotkey itid) lw' hks
     | SDL.ScancodeLCtrl `M.member` _pressedKeys (_input w)
-        || SDL.ScancodeRCtrl `M.member` _pressedKeys (_input w) = fromMaybe w $ do
-        hk <- listToMaybe . mapMaybe scancodeToHotkey $ M.keys $ w ^. input . pressedKeys
-        itid <- w ^? cWorld . lWorld . hotkeys . ix hk . unNInt
-        invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
-        return $ w & augInvDirectSelect (0,invid,mempty)
+        || SDL.ScancodeRCtrl `M.member` _pressedKeys (_input w)
+      , Just hk <- listToMaybe . mapMaybe scancodeToHotkey . M.keys $ w ^. input . pressedKeys
+      , Just itid <- w ^? cWorld . lWorld . hotkeys . ix hk . unNInt
+      , Just invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID =
+        w & augInvDirectSelect (0, invid, mempty)
     | otherwise =
         M.foldl'
             useHotkey
@@ -54,11 +55,12 @@ handleHotkeys w
             (M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
   where
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
+    lw = w ^. cWorld . lWorld
 
 useHotkey :: World -> (NewInt ItmInt, PressType) -> World
 useHotkey w (NInt itid, pt) = fromMaybe w $ do
     invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
-    return $ useItem invid pt w
+    useItem invid pt w
 
 hotkeyToScancode :: Hotkey -> SDL.Scancode
 hotkeyToScancode x = case x of
@@ -152,34 +154,25 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
 {- | Set posture according to mouse presses.
  (should you be aiming without a selected item?)
 -}
-mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
-mouseActionsCr pkeys
+setCrPosture :: M.Map SDL.MouseButton Int -> Creature -> Creature
+setCrPosture pkeys
     | SDL.ButtonRight `M.member` pkeys = crStance . posture .~ Aiming
     | otherwise = crStance . posture .~ AtEase
 
---  where
---    noaction = fromMaybe True $ do
---        theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
---        return $ theaction == NoInvSelAction
-
-pressedMBEffectsTopInventory :: M.Map SDL.MouseButton Int -> World -> World
-pressedMBEffectsTopInventory pkeys w
-    | Just ltime <- pkeys ^? ix SDL.ButtonLeft
-      , Just rtime <- pkeys ^? ix SDL.ButtonRight
-      , ltime <= rtime && inTopInv =
-        fromMaybe w $ do
-            invid <-
-                w
-                    ^? cWorld . lWorld . creatures . ix 0
-                        . crManipulation
-                        . manObject
-                        . imSelectedItem
-            return $ useItem invid (f ltime) w
-    | otherwise = w
+tryClickUse :: M.Map SDL.MouseButton Int -> World -> World
+tryClickUse pkeys w = fromMaybe w $ do
+    ltime <- pkeys ^? ix SDL.ButtonLeft
+    rtime <- pkeys ^? ix SDL.ButtonRight
+    guard $ ltime <= rtime && inTopInv
+    invid <- w
+                ^? cWorld . lWorld . creatures . ix 0
+                    . crManipulation
+                    . manObject
+                    . imSelectedItem
+    useItem invid (f ltime) w
   where
     f 0 = InitialPress
     f _ = ShortPress
-    --    youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown
     inTopInv = case w ^. hud . hudElement of
         DisplayInventory{_subInventory = NoSubInventory{}} -> True
         _ -> False