justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Start moving hotkeys out from creatures into world

Browse Source
This commit is contained in:
justin
2024-12-19 15:16:47 +00:00
parent 11b5ef74c5
commit 4526119fcd
11 changed files with 131 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/UseItem.hs
+8 -4
View File
@@ -53,7 +53,8 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
-- & crpoint . crInvEquipped . at invid ?~ newp
& crpoint . crInv . ix invid . itLocation . ilEquipPosition ?~ newp
& onequip itm cr
& crpoint %~ assignNewHotkey invid
-- & crpoint %~ assignNewHotkey invid
& cWorld . lWorld %~ assignNewHotkey invid
MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
@@ -77,15 +78,18 @@ toggleEquipmentAt invid cr w = case getEquipmentAllocation w of
& crpoint . crInv . ix rid . itLocation . ilEquipPosition .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
& crpoint %~ removeHotkey rid
& crpoint %~ assignNewHotkey invid
-- & crpoint %~ removeHotkey rid
-- & crpoint %~ assignNewHotkey invid
& cWorld . lWorld %~ removeHotkey rid
& cWorld . lWorld %~ assignNewHotkey invid
RemoveEquipment{_allocOldPos = oldp} ->
w
& crpoint . crEquipment . at oldp .~ Nothing
-- & crpoint . crInvEquipped . at invid .~ Nothing
& crpoint . crInv . ix invid . itLocation . ilEquipPosition .~ Nothing
& onremove itm cr
& crpoint %~ removeHotkey invid
-- & crpoint %~ removeHotkey invid
& cWorld . lWorld %~ removeHotkey invid
where
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
itmat i = _crInv cr IM.! i
src/Dodge/Creature/YourControl.hs
+5 -3
View File
@@ -40,9 +40,10 @@ yourControl _ w
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))
| otherwise = foldl' useHotKey w (M.intersection thehotkeys (w ^. input . pressedKeys))
where
hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
--thehotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
useHotKey :: World -> Int -> World
useHotKey w invid = useItemHotkey 0 invid w
@@ -87,7 +88,8 @@ tryAssignHotkey w sc = fromMaybe w $ do
guard (pt == InitialPress)
cr <- w ^? cWorld . lWorld . creatures . ix 0
itid <- cr ^? crManipulation . manObject . imSelectedItem
return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
--return $ w & cWorld . lWorld . creatures . ix 0 %~ assignHotkey itid (scancodeToHotkey sc)
return $ w & cWorld . lWorld %~ assignHotkey itid (scancodeToHotkey sc)
{- | The order of these MAY be important, in particular the setting of crMvAim
within wasdMovement should probably be done first
src/Dodge/Data/Creature.hs
+1 -1
View File
@@ -57,7 +57,7 @@ data Creature = Creature
-- , _crInvEquipped :: IM.IntMap EquipPosition
, _crEquipment :: M.Map EquipPosition Int
, _crInvHotkeys :: IM.IntMap Hotkey
, _crHotkeys :: M.Map Hotkey Int
-- , _crHotkeys :: M.Map Hotkey Int
, _crState :: CreatureState
, _crCorpse :: CreatureCorpse --Creature -> Corpse -> SPic
, _crMaterial :: Material
src/Dodge/Data/LWorld.hs
+2
View File
@@ -92,6 +92,7 @@ import Dodge.Data.WorldEffect
import Geometry.Data
import qualified IntMapHelp as IM
import Picture.Data
import qualified Data.Map.Strict as M
data LWorld = LWorld
{ _creatures :: IM.IntMap Creature
@@ -141,6 +142,7 @@ data LWorld = LWorld
, _lClock :: Int
, _lTestString :: [String]
, _lTestInt :: Int
, _hotkeys :: M.Map Hotkey Int
}
--data WorldBeams = WorldBeams
-- { _blockingBeams :: [Beam]
src/Dodge/Default/Creature.hs
+1 -1
View File
@@ -37,7 +37,7 @@ defaultCreature =
-- , _crInvEquipped = mempty
, _crEquipment = M.empty
, _crInvHotkeys = mempty
, _crHotkeys = M.empty
-- , _crHotkeys = M.empty
, _crStance =
Stance
{ _carriage = Walking 0 WasLeftForward
src/Dodge/Default/World.hs
+1
View File
@@ -148,6 +148,7 @@ defaultLWorld =
, _lClock = 0
, _lTestString = []
, _lTestInt = 0
, _hotkeys = mempty
}
defaultHUD :: HUD
src/Dodge/Hotkey.hs
+29 -19
View File
@@ -11,36 +11,46 @@ import Data.Maybe
import Dodge.Data.World
import Control.Monad
assignNewHotkey :: Int -> Creature -> Creature
assignNewHotkey invid cr = assignHotkey invid (newHotkey cr) cr
assignNewHotkey :: Int -> LWorld -> LWorld
assignNewHotkey invid w = assignHotkey invid (newHotkey w) w
newHotkey :: Creature -> Hotkey
newHotkey cr = fromMaybe maxBound $ find (not . (`M.member` usedhks)) [minBound .. maxBound]
--newHotkey :: Creature -> Hotkey
--newHotkey cr = fromMaybe maxBound $ find (not . (`M.member` usedhks)) [minBound .. maxBound]
-- where
-- usedhks = cr ^?! crHotkeys
newHotkey :: LWorld -> Hotkey
newHotkey lw = fromMaybe maxBound $ find (not . (`M.member` usedhks)) [minBound .. maxBound]
where
usedhks = cr ^?! crHotkeys
usedhks = lw ^. hotkeys
-- 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
assignHotkey :: Int -> Hotkey -> LWorld -> LWorld
assignHotkey invid hk lw = fromMaybe lw $ do
--guard (invid `IM.member` (cr ^. crInvEquipped))
guard $ isJust $ cr ^? crInv . ix invid . itLocation . ilEquipPosition . _Just
_ <- cr ^? crInv . ix invid . itUse . leftUse
return $ (setHotkey invid hk . moveOldHotkey invid hk) cr
guard $ isJust $ lw ^? creatures . ix 0 . crInv . ix invid . itLocation . ilEquipPosition . _Just
_ <- lw ^? creatures . ix 0 . crInv . ix invid . itUse . leftUse
return $ (setHotkey invid hk . moveOldHotkey invid hk) lw
moveOldHotkey :: Int -> Hotkey -> Creature -> Creature
--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
moveOldHotkey :: Int -> Hotkey -> LWorld -> LWorld
moveOldHotkey invid hk w = fromMaybe w $ do
oldhk <- w ^? crInvHotkeys . ix invid
oldid <- w ^? crHotkeys . ix hk
oldhk <- w ^? creatures . ix 0 . crInvHotkeys . ix invid
oldid <- w ^? hotkeys . ix hk
return $ w & setHotkey oldid oldhk
setHotkey :: Int -> Hotkey -> Creature -> Creature
setHotkey i hk = (crInvHotkeys . at i ?~ hk) . (crHotkeys . at hk ?~ i)
setHotkey :: Int -> Hotkey -> LWorld -> LWorld
setHotkey i hk = (creatures . ix 0 . crInvHotkeys . at i ?~ hk) . (hotkeys . at hk ?~ i)
removeHotkey :: Int -> Creature -> Creature
removeHotkey invid cr = cr & crInvHotkeys . at invid .~ Nothing
removeHotkey :: Int -> LWorld -> LWorld
removeHotkey invid w = w & creatures . ix 0 . crInvHotkeys . at invid .~ Nothing
& fromMaybe id (do
hk <- cr ^? crInvHotkeys . ix invid
return (crHotkeys . at hk .~ Nothing)
hk <- w ^? creatures . ix 0 . crInvHotkeys . ix invid
return (hotkeys . at hk .~ Nothing)
)
src/Dodge/Inventory.hs
+4 -2
View File
@@ -69,7 +69,8 @@ rmInvItem cid invid w =
-- & pointcid . crInvEquipped %~ IM.delete invid
-- & pointcid . crInvEquipped %~ IM.mapKeys g
& removeanyactivation
& pointcid . crHotkeys . each %~ g
-- & pointcid . crHotkeys . each %~ g
& cWorld . lWorld . hotkeys . each %~ g
& pointcid . crInvHotkeys %~ IM.delete invid
& pointcid . crInvHotkeys %~ IM.mapKeys g
& updateselection
@@ -101,7 +102,8 @@ rmInvItem cid invid w =
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
--return $ pointcid . crHotkeys . 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/Swap.hs
+6 -3
View File
@@ -34,6 +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
& updateselection
& worldEventFlags . at InventoryChange ?~ ()
& cWorld . lWorld %~ crUpdateItemLocations 0
@@ -58,15 +59,17 @@ swapInvItems f i w = fromMaybe w $ do
. swapSite i k
. swapSite k i
. (crInvHotkeys %~ IM.safeSwapKeys i k)
. swapSite' i k
swaphotkeys k =
swapSite' i k
. swapSite' k i
cr = you w
--swapSite a b = case cr ^? crInvEquipped . ix a of
swapSite a b = case cr ^? crInv . ix a . itLocation . ilEquipPosition . _Just of
Just epos -> crEquipment . ix epos .~ b
Nothing -> id
swapSite' a b = case cr ^? crInvHotkeys . ix a of
Just epos -> crHotkeys . ix epos .~ b
--swapSite' a b = case cr ^? crInvHotkeys . ix a of
swapSite' a b = case w ^? cWorld . lWorld . creatures . ix 0 . crInvHotkeys . ix a of
Just epos -> cWorld . lWorld . hotkeys . ix epos .~ b
Nothing -> id
swapAnyExtraSelection :: Int -> Int -> World -> World