Add file

src/Dodge/Equipment/Text.hs

@@ -0,0 +1,14 @@
+module Dodge.Equipment.Text
+    where
+
+import Dodge.Data.Equipment.Misc
+
+eqPosText :: EquipPosition -> String
+eqPosText ep = case ep of
+    OnHead -> "HEAD"
+    OnChest -> "CHESt"
+    OnBack -> "BACK"
+    OnLeftWrist -> "L.WRIST"
+    OnRightWrist -> "R.WRIST"
+    OnLegs -> "LEGS"
+    OnSpecial -> "EQUIPPED"

src/Dodge/Hotkey.hs

@@ -0,0 +1,46 @@
+module Dodge.Hotkey (
+    assignHotkey,
+    assignNewHotkey,
+    removeHotkey,
+) where
+
+import Control.Lens
+import Data.List
+import qualified Data.Map.Strict as M
+import qualified IntMapHelp as IM
+import Data.Maybe
+import Dodge.Data.World
+import Control.Monad
+
+assignNewHotkey :: Int -> Creature -> Creature
+assignNewHotkey invid cr = assignHotkey invid (newHotkey cr) cr
+
+newHotkey :: Creature -> Hotkey
+newHotkey cr = fromMaybe maxBound $ find (not . (`M.member` usedhks)) [minBound .. maxBound]
+  where
+    usedhks = cr ^?! crHotkeys
+
+-- this will not remove the hotkey from its old slot, assumes there is a hotkey
+-- to swap with instead
+-- requires there actually is equipment in the slot, too
+assignHotkey :: Int -> Hotkey -> Creature -> Creature
+assignHotkey invid hk cr = fromMaybe cr $ do
+    guard (invid `IM.member` (cr ^. crInvEquipped))
+    _ <- cr ^? crInv . ix invid . itUse . leftUse
+    return $ (setHotkey invid hk . moveOldHotkey invid hk) cr
+
+moveOldHotkey :: Int -> Hotkey -> Creature -> Creature
+moveOldHotkey invid hk w = fromMaybe w $ do
+    oldhk <- w ^? crInvHotkeys . ix invid
+    oldid <- w ^? crHotkeys . ix hk
+    return $ w & setHotkey oldid oldhk
+
+setHotkey :: Int -> Hotkey -> Creature -> Creature
+setHotkey i hk = (crInvHotkeys . at i ?~ hk) . (crHotkeys . at hk ?~ i)
+
+removeHotkey :: Int -> Creature -> Creature
+removeHotkey invid cr = cr & crInvHotkeys . at invid .~ Nothing
+    & fromMaybe id (do
+        hk <- cr ^? crInvHotkeys . ix invid
+        return (crHotkeys . at hk .~ Nothing)
+        )