Make hotkeys assignable to any item, use item id

src/Dodge/Creature/YourControl.hs

@@ -2,6 +2,7 @@ module Dodge.Creature.YourControl (
     yourControl,
 ) where
 
+import NewInt
 import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as M
@@ -51,8 +52,9 @@ handleHotkeys w
   where
     thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
 
-useHotkey :: World -> Int -> World
+useHotkey :: World -> NewInt ItmInt -> World
-useHotkey w invid = fromMaybe w $ do
+useHotkey w (NInt itid) = fromMaybe w $ do
+    invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
     cr <- w ^? cWorld . lWorld . creatures . ix 0
     itmloc <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
     return $ heldEffectNoHammerCheck (bimap (^. iatType) (^. _1) itmloc) cr w
@@ -96,7 +98,8 @@ 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 . imSelectedItem
+    invid <- cr ^? crManipulation . manObject . imSelectedItem
+    itid <- cr ^? crInv . ix invid . itID
     --return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
     return $ w & cWorld . lWorld %~ assignHotkey itid (scancodeToHotkey sc)
 

src/Dodge/Data/LWorld.hs

@@ -143,8 +143,8 @@ data LWorld = LWorld
     , _lClock :: Int
     , _lTestString :: [String]
     , _lTestInt :: Int
-    , _hotkeys :: M.Map Hotkey Int
+    , _hotkeys :: M.Map Hotkey (NewInt ItmInt)
-    , _imHotkeys :: IM.IntMap Hotkey
+    , _imHotkeys :: NewIntMap ItmInt Hotkey
     }
 --data WorldBeams = WorldBeams
 --    { _blockingBeams :: [Beam]

src/Dodge/Hotkey.hs

@@ -1,48 +1,21 @@
 module Dodge.Hotkey (
     assignHotkey,
---    assignNewHotkey,
-    removeHotkey,
 ) where
 
+import NewInt
 import Control.Lens
---import Data.List
---import qualified Data.Map.Strict as M
 import Data.Maybe
 import Dodge.Data.World
---import Control.Monad
-
---assignNewHotkey :: Int -> LWorld -> LWorld
---assignNewHotkey invid w = assignHotkey invid (newHotkey w) w
---
---newHotkey :: LWorld -> Hotkey
---newHotkey lw = fromMaybe maxBound $ 
---    find 
---    (not . (`M.member` (lw ^. hotkeys))) 
---    [minBound .. maxBound]
 
 -- it is not obvious to me whether hotkeys should belong to LWorld, CWorld or
 -- World
 
--- this will not remove the hotkey from its old slot, assumes there is a hotkey
+assignHotkey :: NewInt ItmInt -> Hotkey -> LWorld -> LWorld
--- to swap with instead
+assignHotkey (NInt itid) hk lw = lw
-assignHotkey :: Int -> Hotkey -> LWorld -> LWorld
+    & handleoldposition
-assignHotkey invid hk lw = fromMaybe lw $ do
+    & hotkeys . at hk ?~ NInt itid
---    guard $ lw ^? creatures . ix 0 . crInv . ix invid . itUseCondition
+    & imHotkeys . unNIntMap . at itid ?~ hk
---        == Just UseableAnytime
+  where
-    return $ (setHotkey invid hk . moveOldHotkey invid hk) lw
+    handleoldposition = fromMaybe id $ do
-
+        olditid <- lw ^? hotkeys . ix hk . unNInt
-moveOldHotkey :: Int -> Hotkey -> LWorld -> LWorld
+        return $ imHotkeys . unNIntMap . at olditid .~ Nothing
-moveOldHotkey invid hk w = fromMaybe w $ do
-    oldhk <- w ^? imHotkeys . ix invid
-    oldid <- w ^? hotkeys . ix hk
-    return $ w & setHotkey oldid oldhk
-
-setHotkey :: Int -> Hotkey -> LWorld -> LWorld
-setHotkey i hk = (imHotkeys . at i ?~ hk) . (hotkeys . at hk ?~ i)
-
-removeHotkey :: Int -> LWorld -> LWorld
-removeHotkey invid w = w & imHotkeys . at invid .~ Nothing
-    & fromMaybe id (do
-        hk <- w ^? imHotkeys . ix invid
-        return (hotkeys . at hk .~ Nothing)
-        )

src/Dodge/Inventory.hs

@@ -66,10 +66,10 @@ rmInvItem cid invid w =
         & pointcid . crInv %~ f -- important
         & removeAnySlotEquipment
         & pointcid . crEquipment . each %~ g
-        & removeanyactivation
+--        & removeanyactivation
-        & cWorld . lWorld . hotkeys . each %~ g
+--        & cWorld . lWorld . hotkeys . each %~ g
-        & cWorld . lWorld . imHotkeys %~ IM.delete invid
+--        & cWorld . lWorld . imHotkeys %~ IM.delete invid
-        & cWorld . lWorld . imHotkeys %~ IM.mapKeys g
+--        & cWorld . lWorld . imHotkeys %~ IM.mapKeys g
         & updateselection
         & updateselectionextra
         & pointcid %~ updateRootItemID
@@ -96,9 +96,9 @@ rmInvItem cid invid w =
         epos <- w ^? cWorld . lWorld . creatures . ix cid . crInv . ix invid
             . itLocation . ilEquipSite . _Just
         return $ pointcid . crEquipment . at epos .~ Nothing
-    removeanyactivation = fromMaybe id $ do
+--    removeanyactivation = fromMaybe id $ do
-        epos <- w ^? cWorld . lWorld . imHotkeys . ix invid
+--        epos <- w ^? cWorld . lWorld . imHotkeys . ix invid
-        return $ cWorld . lWorld . hotkeys . at epos .~ Nothing
+--        return $ cWorld . lWorld . hotkeys . at epos .~ Nothing
     maxk = fmap fst $ IM.lookupMax $ cr ^. crInv
     f inv =
         let (xs, ys) = IM.split invid inv

src/Dodge/Inventory/SelectionList.hs

@@ -32,7 +32,8 @@ invSelectionItem indent lw i ci =
         }
   where
     cr = lw ^?! creatures . ix 0
-    anyhotkey = maybe [] ((' ' :) . hotkeyToString) (lw ^? imHotkeys . ix i)
+    itid = ci ^. _1 . itID . unNInt
+    anyhotkey = maybe [] ((' ' :) . hotkeyToString) (lw ^? imHotkeys . unNIntMap . ix itid)
     anyequippos = maybe [] (rightPad 8 ' ' . (' ' :) . eqPosText) 
         (ci ^? _1 . itLocation . ilEquipSite . _Just)
     col = itemInvColor ci

src/Dodge/Inventory/Swap.hs

@@ -34,7 +34,7 @@ swapInvItems f i w = fromMaybe w $ do
             & swapAnyExtraSelection i k
             & checkConnection InventorySound disconnectItemS i k
             & cWorld . lWorld . creatures . ix 0 %~ updatecreature k
-            & swaphotkeys k
+--x            & swaphotkeys k
             & updateselection
             & worldEventFlags . at InventoryChange ?~ ()
             & cWorld . lWorld %~ crUpdateItemLocations 0
@@ -59,19 +59,19 @@ swapInvItems f i w = fromMaybe w $ do
             . swapSite i k
             . swapSite k i
 --            . (crInvHotkeys %~ IM.safeSwapKeys i k)
-    swaphotkeys k = 
+--x    swaphotkeys k = 
-             swapSite' i k
+--x             swapSite' i k
-            . swapSite' k i
+--x            . swapSite' k i
-            . (cWorld . lWorld . imHotkeys %~ IM.safeSwapKeys i k)
+--x            . (cWorld . lWorld . imHotkeys %~ IM.safeSwapKeys i k)
     cr = you w
     --swapSite a b = case cr ^? crInvEquipped . ix a of
     swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipSite . _Just of
         Just epos -> crEquipment . ix epos .~ b
         Nothing -> id
     --swapSite' a b = case cr ^? crInvHotkeys . ix a of
-    swapSite' a b = case w ^? cWorld . lWorld . imHotkeys . ix a of
+--x    swapSite' a b = case w ^? cWorld . lWorld . imHotkeys . ix a of
-        Just epos -> cWorld . lWorld . hotkeys . ix epos .~ b
+--x        Just epos -> cWorld . lWorld . hotkeys . ix epos .~ b
-        Nothing -> id
+--x        Nothing -> id
 
 swapAnyExtraSelection :: Int -> Int -> World -> World
 swapAnyExtraSelection i k w = fromMaybe w $ do

src/NewInt.hs

@@ -16,6 +16,7 @@ newtype NewInt a = NInt { _unNInt :: Int}
     deriving newtype (Eq,Ord,Show,Num,Read,Integral,Real,Enum)
 
 newtype NewIntMap a b = NIntMap { _unNIntMap :: IM.IntMap b}
+    deriving newtype (Monoid,Semigroup)
     deriving (Eq,Ord,Show,Read)
 
 makeLenses ''NewInt