Cleanup, stop assigning hotkeys to unequipped items

src/Dodge/Creature/Impulse/UseItem.hs

@@ -2,8 +2,10 @@ module Dodge.Creature.Impulse.UseItem (
     useItem,
     doTopInvLeftClick,
     itemEffect,
+    tryUseL,
 ) where
 
+import Dodge.Hotkey
 import Control.Lens
 import Control.Monad
 import Data.Foldable
@@ -50,7 +52,6 @@ itemEffect cr it w = case it ^. itUse of
         setuhamdown $
             hammerTest
                 ( toggleEquipmentAt (_rbOptions w) itRef cr
-                    . activateEquipmentAt (_rbOptions w) cr
                 )
 
 tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World
@@ -68,13 +69,6 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
   where
     ic = _heldConsumption (_itUse it)
 
-activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
-activateEquipmentAt rbo cr =
-    cWorld . lWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
-        (Just i, _) -> crLeftInvSel . lisMPos ?~ i
-        (_, Just _) -> crLeftInvSel . lisMPos .~ Nothing
-        _ -> id
-
 toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
 toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
     Just DoNotMoveEquipment -> w
@@ -83,6 +77,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
             & crpoint . crEquipment . at newp ?~ invid
             & crpoint . crInvEquipped . at invid ?~ newp
             & onequip itm cr
+            & assignNewHotkey invid
     Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at newp ?~ invid
@@ -101,11 +96,14 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
             & crpoint . crInvEquipped . at rid .~ Nothing
             & onremove (itmat rid) cr
             & onequip itm cr
+            & crpoint %~ removeHotkey rid
+            & assignNewHotkey invid
     Just RemoveEquipment{_allocOldPos = oldp} ->
         w
             & crpoint . crEquipment . at oldp .~ Nothing
             & crpoint . crInvEquipped . at invid .~ Nothing
             & onremove itm cr
+            & crpoint %~ removeHotkey invid
     Nothing -> error "tried to toggle equipment when not prepared"
   where
     crpoint = cWorld . lWorld . creatures . ix (_crID cr)
@@ -118,10 +116,6 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
 doTopInvLeftClick :: Creature -> World -> World
 doTopInvLeftClick cr w = fromMaybe w $ do
     guard . not $ _crInvLock cr
-    return $ doTopInvLeftClick' cr w
-
-doTopInvLeftClick' :: Creature -> World -> World
-doTopInvLeftClick' cr w = fromMaybe (doTopInvLeftClickSearch cr w) $ do
     invid <- cr ^? crManipulation . manObject . inInventory . ispItem
     ituse <- cr ^? crInv . ix invid . itUse
     case ituse of
@@ -136,11 +130,6 @@ equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of
         | otherwise -> useItem cr w
     _ -> tryUseL (_crID cr) invid w
 
-doTopInvLeftClickSearch :: Creature -> World -> World
-doTopInvLeftClickSearch cr w = fromMaybe w $ do
-    invid <- cr ^. crLeftInvSel . lisMPos
-    return $ tryUseL (_crID cr) invid w
-
 tryUseL :: Int -> Int -> World -> World
 tryUseL crid invid w = fromMaybe w $ do
     cr <- w ^? cWorld . lWorld . creatures . ix crid

src/Dodge/Creature/ReaderUpdate.hs

@@ -56,7 +56,7 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
     mtpos = do
         tpos <- _crPos <$> _targetCr int
         guard $ hasLOSIndirect (_crPos cr) tpos w
-        return $ tpos
+        return tpos
     mpos = mtpos <|> _mvToPoint int
 
 setViewPos :: World -> Creature -> Creature
@@ -67,7 +67,7 @@ setViewPos w cr = cr & crIntention . viewPoint %~ ((<|> mpos) . (attentionViewPo
 attentionViewPoint :: World -> Creature -> Maybe Point2
 attentionViewPoint w cr = do
     attention <- cr ^? crPerception . cpAttention . getAttentiveTo
-    cid <- (sortOn snd $ IM.toList attention) ^? ix 0 . _1
+    cid <- sortOn snd (IM.toList attention) ^? ix 0 . _1
     tcr <- w ^? cWorld . lWorld . creatures . ix cid
     guard $ visionCheck cr (_crPos tcr) > 0
     return (_crPos tcr)

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)
+    | 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
+handleHotkeys :: World -> World
---dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
+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
@@ -64,7 +117,9 @@ wasdWithAiming w speed cr
         astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
         let currenttwistamount = cr ^. crTwist
         case (astance, currenttwistamount) of
-            ( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi)
+            (TwoHandTwist, 0) ->
+                return $
+                    (crTwist .~ twistamount * pi)
                         . (crDir -~ twistamount * pi)
             _ -> Nothing
     theMovement
@@ -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
@@ -118,6 +172,8 @@ pressedMBEffectsTopInventory pkeys w
         _ -> False
     isDown but = but `M.member` pkeys
     theinput = w ^. input
-    rotation = maybe 0 
+    rotation =
+        maybe
+            0
             (angleBetween (theinput ^. mousePos))
             (theinput ^. heldPos . at SDL.ButtonMiddle)

src/Dodge/Data/Creature.hs

@@ -56,7 +56,7 @@ data Creature = Creature
     , _crInvLock :: Bool
     , _crInvEquipped :: IM.IntMap EquipPosition
     , _crEquipment :: M.Map EquipPosition Int
-    , _crLeftInvSel :: LeftInvSel
+--    , _crLeftInvSel :: LeftInvSel
     , _crInvHotkeys :: IM.IntMap Hotkey
     , _crHotkeys :: M.Map Hotkey Int
     , _crState :: CreatureState

src/Dodge/Data/Equipment/Misc.hs

@@ -33,6 +33,12 @@ data Hotkey = HotkeyQ
     | Hotkey2
     | Hotkey3
     | Hotkey4
+    | Hotkey5
+    | Hotkey6
+    | Hotkey7
+    | Hotkey8
+    | Hotkey9
+    | Hotkey0
   deriving (Eq, Show, Read, Ord, Bounded, Enum) --Generic, Flat)
 
 

src/Dodge/Data/Item/Use/Consumption/LoadAction.hs

@@ -27,7 +27,6 @@ data Manipulation -- should be ManipulatedObject?
 data ManipulatedObject
     = InInventory {_inInventory :: InventoryManipulation}
     | SelNothing
---    | SelCloseObject {_ispCloseObject :: Int}
     | InNearby {_inNearby :: NearbyManipulation}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
@@ -46,16 +45,11 @@ data InvSelAction
     | ReloadAction {_actionProgress :: Int, _reloadAction :: LoadAction}
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
-data LeftInvSel = LeftInvSel
-    { _lisMPos :: Maybe Int
-    }
-
 makeLenses ''LoadAction
 makeLenses ''ManipulatedObject
 makeLenses ''Manipulation
 makeLenses ''InventoryManipulation
 makeLenses ''NearbyManipulation
-makeLenses ''LeftInvSel
 makeLenses ''InvSelAction
 deriveJSON defaultOptions ''LoadAction
 deriveJSON defaultOptions ''InvSelAction
@@ -63,4 +57,3 @@ deriveJSON defaultOptions ''InventoryManipulation
 deriveJSON defaultOptions ''NearbyManipulation
 deriveJSON defaultOptions ''ManipulatedObject
 deriveJSON defaultOptions ''Manipulation
-deriveJSON defaultOptions ''LeftInvSel

src/Dodge/Default/Creature.hs

@@ -30,7 +30,6 @@ defaultCreature =
         , _crManipulation = Manipulator SelNothing
         , _crInvCapacity = 25
         , _crInvLock = False
-        , _crLeftInvSel = LeftInvSel Nothing
         , _crState = defaultState
         , _crCorpse = MakeDefaultCorpse
         , _crMaterial = Flesh

src/Dodge/Inventory.hs

@@ -51,13 +51,21 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     _ ->
         w
             & pointcid %~ crCancelReloading
-            & removeAnySlotEquipment    -- the ordering
-            & dounequipfunction         -- of these is
-            & pointcid . crInv %~ f     -- important
-            & pointcid . crLeftInvSel . lisMPos %~ g'
             & doanyitemeffect
+            & dounequipfunction         --the ordering of these is
+            & pointcid . crInv %~ f     -- important
+--            & pointcid . crLeftInvSel . lisMPos %~ g'
+
+            & removeAnySlotEquipment
+            & pointcid . crEquipment . each %~ g
             & pointcid . crInvEquipped %~ IM.delete invid
             & pointcid . crInvEquipped %~ IM.mapKeys g
+
+            & removeanyactivation
+            & pointcid . crHotkeys . each %~ g
+            & pointcid . crInvHotkeys %~ IM.delete invid
+            & pointcid . crInvHotkeys %~ IM.mapKeys g
+
             & updateselection
             & worldEventFlags . at InventoryChange ?~ ()
   where
@@ -81,6 +89,9 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     removeAnySlotEquipment = fromMaybe id $ do
         epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvEquipped . ix invid
         return $ pointcid . crEquipment . at epos .~ Nothing
+    removeanyactivation = fromMaybe id $ do
+        epos <- w ^? cWorld . lWorld . creatures . ix cid . crInvHotkeys . ix invid
+        return $ pointcid . crHotkeys . at epos .~ Nothing
     maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
     f inv =
         let (xs, ys) = IM.split invid inv
@@ -89,11 +100,11 @@ rmInvItem cid invid w = case w ^? getcid . crInv . ix invid . itUse . useAmount
     g x
         | x > invid || Just x == maxk = max 0 $ x - 1
         | otherwise = x
-    g' Nothing = Nothing
+--    g' Nothing = Nothing
-    g' (Just x)
+--    g' (Just x)
-        | x == invid = Nothing
+--        | x == invid = Nothing
-        | x > invid || Just x == maxk = Just $ max 0 $ x - 1
+--        | x > invid || Just x == maxk = Just $ max 0 $ x - 1
-        | otherwise = Just x
+--        | otherwise = Just x
 
 rmSelectedInvItem :: Int -> World -> World
 rmSelectedInvItem cid w = case w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem of
@@ -131,7 +142,7 @@ updateCloseObjects w =
 updateRBList :: World -> World
 updateRBList w
     | w ^? rbOptions . opItemID == mcurrentitemid =
-        w & setEquipAllocationActivation
+        w & setEquipAllocation
     | otherwise = fromMaybe (w & rbOptions .~ NoRightButtonOptions) $ do
         i <- cr ^? crManipulation . manObject . inInventory . ispItem
         esite <- cr ^? crInv . ix i . itUse . equipEffect . eeSite
@@ -146,7 +157,7 @@ updateRBList w
                         , _opAllocateEquipment = DoNotMoveEquipment
                         , _opActivateEquipment = NoChangeActivateEquipment
                         }
-                & setEquipAllocationActivation
+                & setEquipAllocation
   where
     mcurrentitemid = do
         i <- cr ^? crManipulation . manObject . inInventory . ispItem
@@ -164,9 +175,6 @@ chooseFreeSite cr = fromMaybe 0 . findIndex hasnoequipment
   where
     hasnoequipment ep = isNothing $ cr ^? crEquipment . ix ep
 
-setEquipAllocationActivation :: World -> World
-setEquipAllocationActivation = setEquipActivation . setEquipAllocation
-
 setEquipAllocation :: World -> World
 setEquipAllocation w = fromMaybe w $ do
     curpos <- you w ^? crManipulation . manObject . inInventory . ispItem
@@ -196,46 +204,46 @@ setEquipAllocation w = fromMaybe w $ do
                         }
             Nothing -> PutOnEquipment{_allocNewPos = es}
 
-setEquipActivation :: World -> World
+--setEquipActivation :: World -> World
-setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
+--setEquipActivation w = case w ^? rbOptions . opAllocateEquipment of
-    Just DoNotMoveEquipment -> w
+--    Just DoNotMoveEquipment -> w
-    Just RemoveEquipment{} ->
+--    Just RemoveEquipment{} ->
-        case you w ^. crLeftInvSel . lisMPos of
+--        case you w ^. crLeftInvSel . lisMPos of
-            Just i
+--            Just i
-                | Just i == minvsel ->
+--                | Just i == minvsel ->
-                    w & rbOptions . opActivateEquipment
+--                    w & rbOptions . opActivateEquipment
-                        .~ DeactivateEquipment
+--                        .~ DeactivateEquipment
-                            { _deactivateEquipment = i
+--                            { _deactivateEquipment = i
-                            }
+--                            }
-            _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--            _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-    Just rbos ->
+--    Just rbos ->
-        case you w ^. crLeftInvSel . lisMPos of
+--        case you w ^. crLeftInvSel . lisMPos of
-            Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--            Just i | Just i == minvsel -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-            Just i
+--            Just i
-                | invselcanactivate ->
+--                | invselcanactivate ->
-                    w & rbOptions . opActivateEquipment
+--                    w & rbOptions . opActivateEquipment
-                        .~ ActivateDeactivateEquipment
+--                        .~ ActivateDeactivateEquipment
-                            { _activateEquipment = fromJust minvsel
+--                            { _activateEquipment = fromJust minvsel
-                            , _deactivateEquipment = i
+--                            , _deactivateEquipment = i
-                            }
+--                            }
-            Just i
+--            Just i
-                | Just i == rbos ^? allocRemoveID ->
+--                | Just i == rbos ^? allocRemoveID ->
-                    w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
+--                    w & rbOptions . opActivateEquipment .~ DeactivateEquipment i
-            Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--            Just _ -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-            Nothing
+--            Nothing
-                | invselcanactivate ->
+--                | invselcanactivate ->
-                    w & rbOptions . opActivateEquipment
+--                    w & rbOptions . opActivateEquipment
-                        .~ ActivateEquipment
+--                        .~ ActivateEquipment
-                            { _activateEquipment = fromJust minvsel
+--                            { _activateEquipment = fromJust minvsel
-                            }
+--                            }
-            Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--            Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-    Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
+--    Nothing -> w & rbOptions . opActivateEquipment .~ NoChangeActivateEquipment
-  where
+--  where
-    minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
+--    minvsel = cr ^? crManipulation . manObject . inInventory . ispItem
-    cr = you w
+--    cr = you w
-    invselcanactivate = isJust $ do
+--    invselcanactivate = isJust $ do
-        i <- minvsel
+--        i <- minvsel
-        return $ cr ^? crInv . ix i . itUse . leftUse
+--        return $ cr ^? crInv . ix i . itUse . leftUse
 
 equipSiteToPositions :: EquipSite -> [EquipPosition]
 equipSiteToPositions es = case es of
@@ -288,21 +296,27 @@ changeSwapInv f i w = fromMaybe w $ do
             & hud . hudElement . diSections . sssExtra . sssSelPos . _Just . _2 .~ k
             & worldEventFlags . at InventoryChange ?~ ()
   where
-    updateLeftInvSel k li
+--    updateLeftInvSel k li
-        | i == li = k
+--        | i == li = k
-        | k == li = i
+--        | k == li = i
-        | otherwise = li
+--        | otherwise = li
     updatecreature k =
         (crInv %~ IM.safeSwapKeys i k)
-            . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
+--            . (crLeftInvSel . lisMPos . _Just %~ updateLeftInvSel k)
             . (crManipulation . manObject . inInventory . ispItem .~ k)
             . (crInvEquipped %~ IM.safeSwapKeys i k)
             . swapSite i k
             . swapSite k i
+            . (crInvHotkeys %~ IM.safeSwapKeys i k)
+            . swapSite' i k
+            . swapSite' k i
     cr = you w
     swapSite a b = case cr ^? crInvEquipped . ix a of
         Just epos -> crEquipment . ix epos .~ b
         Nothing -> id
+    swapSite' a b = case cr ^? crInvHotkeys . ix a of
+        Just epos -> crHotkeys . ix epos .~ b
+        Nothing -> id
 
 changeSwapWith :: (Int -> IM.IntMap (SelectionItem ()) -> Maybe Int) -> World -> World
 changeSwapWith f w = case w ^? hud . hudElement . diSections . sssExtra . sssSelPos . _Just of

src/Dodge/Inventory/SelectionList.hs

@@ -3,6 +3,7 @@ module Dodge.Inventory.SelectionList (
     closeObjectToSelectionItem,
 ) where
 
+import Dodge.Equipment.Text
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.Item.SlotsTaken
@@ -13,7 +14,7 @@ import Picture.Base
 invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
 invSelectionItem cr i it =
     SelectionItem
-        { _siPictures = pics
+        { _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
         , _siHeight = length pics
         , _siIsSelectable = True
         , _siColor = col
@@ -21,12 +22,29 @@ invSelectionItem cr i it =
         , _siPayload = ()
         }
   where
+    anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
+    anyequippos = maybe [] ((' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
     col = _itInvColor it
     pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
         UndroppableIdentified -> itemDisplay it
         _ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
         _ -> itemDisplay it
 
+hotkeyToString :: Hotkey -> String
+hotkeyToString x = case x of
+    HotkeyQ -> "[Q]"
+    HotkeyE -> "[E]"
+    Hotkey1 -> "[1]"
+    Hotkey2 -> "[2]"
+    Hotkey3 -> "[3]"
+    Hotkey4 -> "[4]"
+    Hotkey5 -> "[5]"
+    Hotkey6 -> "[6]"
+    Hotkey7 -> "[7]"
+    Hotkey8 -> "[8]"
+    Hotkey9 -> "[9]"
+    Hotkey0 -> "[0]"
+
 closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem ()
 closeObjectToSelectionItem e =
     SelectionItem

src/Dodge/ItEffect.hs

@@ -1,5 +1,6 @@
 module Dodge.ItEffect where
 
+import qualified IntMapHelp as IM
 import Control.Lens
 import Dodge.Data.World
 import Dodge.Euse
@@ -49,7 +50,7 @@ chargeIfInInventory itm cr w =
 
 chargeIfEquipped :: Item -> Creature -> World -> World
 chargeIfEquipped itm cr
-    | Just invid == cr ^. crLeftInvSel . lisMPos =
+    | invid `IM.member` (cr ^. crInvHotkeys)  =
         ptrWpCharge %~ (min maxcharge . (+ 1))
     | otherwise = ptrWpCharge .~ 0
   where

src/Dodge/Render/HUD.hs

@@ -3,9 +3,8 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
-import Dodge.SelectionSections
 import Control.Lens
-import Data.Foldable
+import Control.Monad
 import qualified Data.Map.Strict as M
 import Data.Maybe
 import qualified Data.Vector as V
@@ -18,11 +17,13 @@ import Dodge.Data.Config
 import Dodge.Data.SelectionList
 import Dodge.Data.World
 import Dodge.Default.SelectionList
+import Dodge.Equipment.Text
 import Dodge.Inventory
 import Dodge.Item.Info
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
 import Dodge.Render.List
+import Dodge.SelectionSections
 import Dodge.SelectionSections.Draw
 import Dodge.Tweak.Show
 import Geometry
@@ -50,7 +51,7 @@ drawInventory sss = drawSelectionSections sss . invDisplayParams
 drawSubInventory :: SubInventory -> Configuration -> World -> Picture
 drawSubInventory subinv cfig w = case subinv of
     LockedInventory -> mempty -- topInvCursor col cursPos cfig w
-    NoSubInventory -> drawNoSubInventory cfig w
+    NoSubInventory -> drawRBOptions cfig w
     ExamineInventory mtweaki -> drawExamineInventory cfig mtweaki w
     DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
     CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
@@ -109,125 +110,12 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
     Just (InNearby (SelCloseObject i)) -> g $ w ^?! hud . closeObjects . ix i
     _ -> x
 
-drawNoSubInventory :: Configuration -> World -> Picture
+drawRBOptions :: Configuration -> World -> Picture
-drawNoSubInventory cfig w =
+drawRBOptions cfig w = fromMaybe mempty $ do
-    fold
+    guard $ ButtonRight `M.member` _mouseButtons (_input w)
-        [ equipcursors
+    es <- w ^? rbOptions . opEquip
-        , equipcursor -- the order is important, this should go on top of the other equipcursors
+    i <- w ^? rbOptions . opSel
-        , rboptions
+    ae <- w ^? rbOptions . opAllocateEquipment
-        ]
-  where
-    equipcursor = fromMaybe mempty $ do
-        invid <- cr ^. crLeftInvSel . lisMPos
-        sss <- w ^? hud . hudElement . diSections
-        pos <- selSecSelPos 0 invid sss
-        return $
-            listTextPictureAt 144 0 cfig pos . color cyan . text . eqPosText $
-                _crInvEquipped cr IM.! invid
-    f col invid epos = fromMaybe mempty $ do
-        sss <- w ^? hud . hudElement . diSections
-        pos <- selSecSelPos 0 invid sss
-        return $ listTextPictureAt 144 0 cfig pos . color col $ text $ eqPosText epos
-    equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
-    cr = you w
-    rboptions
-        | ButtonRight `M.member` _mouseButtons (_input w) = drawRBOptions cfig w (_rbOptions w)
-        | otherwise = mempty
-
-examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
-examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
-    tweaki <- mtweaki
-    -- consider moving this functionality out into a tweaks module
-    tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
-    return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
-
-combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
-combineInventoryExtra sss cfig w = fromMaybe mempty $ do
-    (i, j) <- sss ^? sssExtra . sssSelPos . _Just
-    si <- sss ^? sssSections . ix i . ssItems . ix j
-    cpos <- selSecSelPos i j sss
-    let col = _siColor si
-    return $
-        pictures
-            [ fromMaybe mempty $ do
-                strs <- si ^? siPayload . ciInfo
-                return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
-            , fromMaybe mempty $ do
-                lnks <- si ^? siPayload . ciInvIDs
-                return $
-                    lnkMidPosInvSelsCol cfig w cpos col lnks
-                        <> foldMap invcursor lnks
-                        <> combineCounts cfig w lnks
-            ]
-  where
-    invcursor i = fromMaybe mempty $ do
-        sss' <- w ^? hud . hudElement . diSections
-        return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i
-
---    fromMaybe mempty $ do
---    i <- mi
---    let cpos = getIthPos i (sm ^. smShownItems)
---    col <- sm ^? smShownItems . ix i . siColor
---    return $
---        pictures
---            [ fromMaybe mempty $ do
---                strs <- sm ^? smShownItems . ix i . siPayload . ciInfo
---                return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
---            , fromMaybe mempty $ do
---                lnks <- sm ^? smShownItems . ix i . siPayload . ciInvIDs
---                return $
---                    lnkMidPosInvSelsCol cfig w cpos col lnks
---                        -- <> foldMap (topCursorTypeWidth listCursorNESW (topInvW + 2) cfig w) lnks
---                        <> foldMap invcursor lnks
---                        <> combineCounts cfig w lnks
---            ]
---  where
---    invcursor i = fromMaybe mempty $ do
---        sss <- w ^? hud . hudElement . diSections
---        return $ selSecDrawCursor 17 [North,South,East] cfig (invDisplayParams w) sss 0 i
-
---thirdColumnPara :: [String] -> SelectionList ()
---thirdColumnPara strs = SelectionList (map f strs) Nothing (length strs)
---  where
---    f str =
---        SelectionItem
---            { _siPictures = [text str]
---            , _siHeight = 1
---            , _siIsSelectable = True
---            , _siWidth = length str
---            , _siColor = white
---            , _siOffX = 0
---            , _siPayload = ()
---            }
-
-displayTerminal :: Int -> Configuration -> LWorld -> Picture
-displayTerminal tid cfig w = fromMaybe mempty $ do
-    tm <- w ^? terminals . ix tid
-    return $
-        invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
-            <> drawSelectionList secondColumnParams cfig (thesellist tm)
-  where
-    toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
-    thesellist tm = defaultSelectionList & slItems .~ thelist tm
-    thelist tm =
-        map toselitm . displayTermInput tm
-            . reverse
-            . take (_tmMaxLines tm)
-            $ _tmDisplayedLines tm
-    displayTermInput tm = case _tmInput tm of
-        TerminalInput {_tiText = s,  _tiFocus = hasfoc}
-            -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
-    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
-    displayInputText tm s
-        | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
-        | otherwise = ""
-    displayBlinkCursor hasfoc
-        | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
-        | otherwise = []
-
-drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
-drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipment = ae} =
-    fromMaybe mempty $ do
     sss <- w ^? hud . hudElement . diSections
     (i', j) <- sss ^? sssExtra . sssSelPos . _Just
     curpos <- selSecSelPos i' j sss
@@ -252,17 +140,61 @@ drawRBOptions cfig w EquipOptions{_opEquip = es, _opSel = i, _opAllocateEquipmen
         Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
         Nothing -> ""
     otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
-drawRBOptions _ _ _ = mempty
 
-eqPosText :: EquipPosition -> String
+examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
-eqPosText ep = case ep of
+examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
-    OnHead -> "HEAD"
+    tweaki <- mtweaki
-    OnChest -> "CHEST"
+    -- consider moving this functionality out into a tweaks module
-    OnBack -> "BACK"
+    tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
-    OnLeftWrist -> "L.WRIST"
+    return $ listCursorNSW subInvX 60 cfig tweaki 0 white (length $ showTweak tparam) 15
-    OnRightWrist -> "R.WRIST"
+
-    OnLegs -> "LEGS"
+combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
-    OnSpecial -> "EQUIPPED"
+combineInventoryExtra sss cfig w = fromMaybe mempty $ do
+    (i, j) <- sss ^? sssExtra . sssSelPos . _Just
+    si <- sss ^? sssSections . ix i . ssItems . ix j
+    cpos <- selSecSelPos i j sss
+    let col = _siColor si
+    return $
+        mconcat
+            [ fromMaybe mempty $ do
+                strs <- si ^? siPayload . ciInfo
+                return $ listPicturesAtOff (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
+            , fromMaybe mempty $ do
+                lnks <- si ^? siPayload . ciInvIDs
+                return $
+                    lnkMidPosInvSelsCol cfig w cpos col lnks
+                        <> foldMap invcursor lnks
+                        <> combineCounts cfig w lnks
+            ]
+  where
+    invcursor i = fromMaybe mempty $ do
+        sss' <- w ^? hud . hudElement . diSections
+        return $ selSecDrawCursor 17 [North, South, East] cfig (invDisplayParams w) sss' 0 i
+
+displayTerminal :: Int -> Configuration -> LWorld -> Picture
+displayTerminal tid cfig w = fromMaybe mempty $ do
+    tm <- w ^? terminals . ix tid
+    return $
+        invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
+            <> drawSelectionList secondColumnParams cfig (thesellist tm)
+  where
+    toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
+    thesellist tm = defaultSelectionList & slItems .~ thelist tm
+    thelist tm =
+        map toselitm . displayTermInput tm
+            . reverse
+            . take (_tmMaxLines tm)
+            $ _tmDisplayedLines tm
+    displayTermInput tm = case _tmInput tm of
+        TerminalInput{_tiText = s, _tiFocus = hasfoc} ->
+            (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
+    partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
+    displayInputText tm s
+        | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
+        | otherwise = ""
+    displayBlinkCursor hasfoc
+        | hasfoc = clockCycle 10 (V.fromList ["_", "."]) w
+        | otherwise = []
 
 combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = foldMap f . group

src/Dodge/Terminal.hs

@@ -262,7 +262,7 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
                             makeTermPara ("Expects " ++ argtype ++ " as an argument")
                     | otherwise = 
                         TerminalLineTerminalEffect 0 (TmTmSetPartialCommand Nothing) :
-                            makeTermPara ("No argument input, cancelling")
+                            makeTermPara "No argument input, cancelling"
              in Just $
                     fromMaybe setpartial $
                         safeHead args >>= (m M.!?)

src/Dodge/TestString.hs

@@ -18,10 +18,14 @@ import Dodge.Data.Universe
 --import qualified Data.Map.Strict as M
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount
+testStringInit u =  getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
-    , show $ getSmoothScrollValue (u ^. uvWorld . input)
+    <> ["---"]
-    , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
+    <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
-    ]
+    
+--    [show $ u ^. uvWorld . input . smoothScrollAmount
+--    , show $ getSmoothScrollValue (u ^. uvWorld . input)
+--    , show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
+--    ]
 --    [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam) 
 --        (u ^. uvWorld . cWorld . lWorld)
 --        , show a