Cleanup, stop assigning hotkeys to unequipped items

src/Dodge/Creature/YourControl.hs

@@ -2,16 +2,19 @@ module Dodge.Creature.YourControl (
     yourControl,
 ) where
 
-import Dodge.WASD
-import Dodge.Base.You
 import Dodge.Creature.Impulse.UseItem
+import Dodge.Hotkey
+import Control.Monad
+import Data.Foldable
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Base.Coordinate
+import Dodge.Base.You
 import Dodge.Creature.Impulse.Movement
 import Dodge.Creature.Test
 import Dodge.Data.World
 import Dodge.InputFocus
+import Dodge.WASD
 import Geometry
 import LensHelp
 import qualified SDL
@@ -20,13 +23,15 @@ import qualified SDL
 yourControl :: Creature -> World -> World
 yourControl cr w
     | inInputFocus w = w
-    | not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr)
-                %~ wasdWithAiming w (_mvSpeed $ _crMvType cr)    
+    | not intopinv =
+        w & cWorld . lWorld . creatures . ix (_crID cr)
+            %~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
     | otherwise =
         w
             & cWorld . lWorld . creatures . ix (_crID cr)
                 %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
             & pressedMBEffectsTopInventory pkeys
+            & handleHotkeys
   where
     pkeys = w ^. input . mouseButtons
     intopinv = fromMaybe False $ do
@@ -35,12 +40,60 @@ yourControl cr w
             NoSubInventory -> True
             _ -> False
 
---dimCreatureLight :: Creature -> World -> World
---dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
+handleHotkeys :: World -> World
+handleHotkeys w
+    | SDL.ButtonRight `M.member` _mouseButtons (_input w) = foldl' tryAssignHotkey w allHotkeys
+    | otherwise = foldl' useHotKey w (M.intersection hotkeys (w ^. input . pressedKeys))
+  where
+    hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
 
--- note the order of operation, setting the posture first--this prevents the twist fire bug
+useHotKey :: World -> Int -> World
+useHotKey w invid = tryUseL 0 invid w
+
+allHotkeys :: [SDL.Scancode]
+allHotkeys = map hotkeyToScancode [minBound .. maxBound]
+
+hotkeyToScancode :: Hotkey -> SDL.Scancode
+hotkeyToScancode x = case x of
+    HotkeyQ -> SDL.ScancodeQ
+    HotkeyE -> SDL.ScancodeE
+    Hotkey1 -> SDL.Scancode1
+    Hotkey2 -> SDL.Scancode2
+    Hotkey3 -> SDL.Scancode3
+    Hotkey4 -> SDL.Scancode4
+    Hotkey5 -> SDL.Scancode5
+    Hotkey6 -> SDL.Scancode6
+    Hotkey7 -> SDL.Scancode7
+    Hotkey8 -> SDL.Scancode8
+    Hotkey9 -> SDL.Scancode9
+    Hotkey0 -> SDL.Scancode0
+
+scancodeToHotkey :: SDL.Scancode -> 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
+    itid <- cr ^? crManipulation . manObject . inInventory . ispItem
+    return $ assignHotkey itid (scancodeToHotkey sc) w
 
 -- | Turn key presses into creature movement.
+-- | note the order of operation, setting the posture first--this prevents the twist fire bug
 wasdWithAiming ::
     World ->
     -- | Base speed
@@ -63,9 +116,11 @@ wasdWithAiming w speed cr
         itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
         astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
         let currenttwistamount = cr ^. crTwist
-        case (astance,currenttwistamount) of
-            ( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi)
-                    . (crDir -~ twistamount * pi)
+        case (astance, currenttwistamount) of
+            (TwoHandTwist, 0) ->
+                return $
+                    (crTwist .~ twistamount * pi)
+                        . (crDir -~ twistamount * pi)
             _ -> Nothing
     theMovement
         | movDir == V2 0 0 = id
@@ -78,8 +133,8 @@ wasdWithAiming w speed cr
     dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
     movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
     isAiming = _posture (_crStance cr) == Aiming
-    mouseDir = fromMaybe 
-        (argV (_mousePos (_input w)) + (w ^. wCam . camRot) )
+    mouseDir = fromMaybe
+        (argV (_mousePos (_input w)) + (w ^. wCam . camRot))
         $ do
             itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
             _ <- cr ^? crInv . ix itRef . itScope . scopePos
@@ -92,7 +147,6 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
         itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
         cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
 
-
 -- | Set posture according to mouse presses.
 mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
 mouseActionsCr pkeys cr
@@ -114,10 +168,12 @@ pressedMBEffectsTopInventory pkeys w
     | otherwise = w
   where
     inTopInv = case w ^. hud . hudElement of
-        DisplayInventory {_subInventory = NoSubInventory} -> True
+        DisplayInventory{_subInventory = NoSubInventory} -> True
         _ -> False
     isDown but = but `M.member` pkeys
     theinput = w ^. input
-    rotation = maybe 0 
-        (angleBetween (theinput ^. mousePos)) 
-        (theinput ^. heldPos . at SDL.ButtonMiddle)
+    rotation =
+        maybe
+            0
+            (angleBetween (theinput ^. mousePos))
+            (theinput ^. heldPos . at SDL.ButtonMiddle)