Refactor hotkey assignation

src/Dodge/Creature/YourControl.hs

@@ -2,20 +2,15 @@ module Dodge.Creature.YourControl (
     yourControl,
 ) where
 
-import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.Coordinate
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Impulse.UseItem
-import Dodge.Data.ComposedItem
-import Dodge.Data.DoubleTree
 import Dodge.Data.World
-import Dodge.HeldUse
 import Dodge.Hotkey
 import Dodge.InputFocus
-import Dodge.Item.Grammar
 import Dodge.WASD
 import Geometry
 import LensHelp
@@ -40,8 +35,11 @@ yourControl _ w
 handleHotkeys :: World -> World
 handleHotkeys w
     | SDL.ScancodeLShift `M.member` _pressedKeys (_input w)
-        || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) =
-        foldl' tryAssignHotkey w allHotkeys
+        || 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
     | otherwise =
         M.foldl'
             useHotkey
@@ -50,16 +48,13 @@ handleHotkeys w
   where
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
 
-useHotkey :: World -> (NewInt ItmInt,PressType) -> World
-useHotkey w (NInt itid,pt) = fromMaybe w $ do
+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
---    cr <- w ^? cWorld . lWorld . creatures . ix 0
---    itmloc <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
---    return $ heldEffectNoHammerCheck (bimap (^. iatType) (^. _1) itmloc) cr w
 
-allHotkeys :: [SDL.Scancode]
-allHotkeys = map hotkeyToScancode [minBound .. maxBound]
+--allHotkeys :: [SDL.Scancode]
+--allHotkeys = map hotkeyToScancode [minBound .. maxBound]
 
 hotkeyToScancode :: Hotkey -> SDL.Scancode
 hotkeyToScancode x = case x of
@@ -76,30 +71,21 @@ hotkeyToScancode x = case x of
     Hotkey9 -> SDL.Scancode9
     Hotkey0 -> SDL.Scancode0
 
-scancodeToHotkey :: SDL.Scancode -> Hotkey
+scancodeToHotkey :: SDL.Scancode -> Maybe Hotkey
 scancodeToHotkey x = case x of
-    SDL.ScancodeQ -> HotkeyQ
-    SDL.ScancodeE -> HotkeyE
-    SDL.Scancode1 -> Hotkey1
-    SDL.Scancode2 -> Hotkey2
-    SDL.Scancode3 -> Hotkey3
-    SDL.Scancode4 -> Hotkey4
-    SDL.Scancode5 -> Hotkey5
-    SDL.Scancode6 -> Hotkey6
-    SDL.Scancode7 -> Hotkey7
-    SDL.Scancode8 -> Hotkey8
-    SDL.Scancode9 -> Hotkey9
-    SDL.Scancode0 -> Hotkey0
-    _ -> undefined
-
-tryAssignHotkey :: World -> SDL.Scancode -> World
-tryAssignHotkey w sc = fromMaybe w $ do
-    pt <- w ^? input . pressedKeys . ix sc
-    guard (pt == InitialPress)
-    cr <- w ^? cWorld . lWorld . creatures . ix 0
-    invid <- cr ^? crManipulation . manObject . imSelectedItem
-    itid <- cr ^? crInv . ix invid . itID
-    return $ w & cWorld . lWorld %~ assignHotkey itid (scancodeToHotkey sc)
+    SDL.ScancodeQ -> Just HotkeyQ
+    SDL.ScancodeE -> Just HotkeyE
+    SDL.Scancode1 -> Just Hotkey1
+    SDL.Scancode2 -> Just Hotkey2
+    SDL.Scancode3 -> Just Hotkey3
+    SDL.Scancode4 -> Just Hotkey4
+    SDL.Scancode5 -> Just Hotkey5
+    SDL.Scancode6 -> Just Hotkey6
+    SDL.Scancode7 -> Just Hotkey7
+    SDL.Scancode8 -> Just Hotkey8
+    SDL.Scancode9 -> Just Hotkey9
+    SDL.Scancode0 -> Just Hotkey0
+    _ -> Nothing
 
 {- | The order of these MAY be important, in particular the setting of crMvAim
  within wasdMovement should probably be done first
@@ -178,14 +164,18 @@ pressedMBEffectsTopInventory pkeys w
       , Just rtime <- pkeys ^? ix SDL.ButtonRight
       , ltime <= rtime && inTopInv =
         fromMaybe w $ do
-            invid <- w ^? cWorld . lWorld . creatures . ix 0 
-                . crManipulation . manObject . imSelectedItem
+            invid <-
+                w
+                    ^? cWorld . lWorld . creatures . ix 0
+                        . crManipulation
+                        . manObject
+                        . imSelectedItem
             return $ useItem invid (f ltime) w
     | otherwise = w
   where
     f 0 = InitialPress
     f _ = ShortPress
---    youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown
+    --    youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown
     inTopInv = case w ^. hud . hudElement of
         DisplayInventory{_subInventory = NoSubInventory{}} -> True
         _ -> False

src/Dodge/Data/Item.hs

@@ -41,7 +41,6 @@ data Consumables
 data Item = Item
     { _itUse :: ItemUse
     , _itUseCondition :: UseCondition
---    , _itUseFocus :: UseFocus
     , _itConsumables :: Consumables
     , _itType :: ItemType
     , _itID :: NewInt ItmInt