diff --git a/src/Dodge/Equipment/Text.hs b/src/Dodge/Equipment/Text.hs new file mode 100644 index 000000000..fc2ca3d83 --- /dev/null +++ b/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" diff --git a/src/Dodge/Hotkey.hs b/src/Dodge/Hotkey.hs new file mode 100644 index 000000000..86bf76b44 --- /dev/null +++ b/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) + )