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

Refactor hotkey assignation

Browse Source
This commit is contained in:
justin
2024-12-31 13:24:10 +00:00
parent 17da9e00f8
commit 99114c7351
2 changed files with 30 additions and 41 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/YourControl.hs
+30 -40
View File
@@ -2,20 +2,15 @@ module Dodge.Creature.YourControl (
yourControl, yourControl,
) where ) where
import Control.Monad
import Data.Foldable import Data.Foldable
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import Dodge.Base.Coordinate import Dodge.Base.Coordinate
import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Impulse.UseItem import Dodge.Creature.Impulse.UseItem
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.World import Dodge.Data.World
import Dodge.HeldUse
import Dodge.Hotkey import Dodge.Hotkey
import Dodge.InputFocus import Dodge.InputFocus
import Dodge.Item.Grammar
import Dodge.WASD import Dodge.WASD
import Geometry import Geometry
import LensHelp import LensHelp
@@ -40,8 +35,11 @@ yourControl _ w
handleHotkeys :: World -> World handleHotkeys :: World -> World
handleHotkeys w handleHotkeys w
| SDL.ScancodeLShift `M.member` _pressedKeys (_input w) | SDL.ScancodeLShift `M.member` _pressedKeys (_input w)
|| SDL.ScancodeRShift `M.member` _pressedKeys (_input w) = || SDL.ScancodeRShift `M.member` _pressedKeys (_input w) = fromMaybe w $ do
foldl' tryAssignHotkey w allHotkeys let hks = mapMaybe scancodeToHotkey $ M.keys $ w ^. input . pressedKeys
invid <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . imSelectedItem
itid <- w ^? cWorld . lWorld . creatures . ix 0 . crInv . ix invid . itID
return $ w & cWorld . lWorld %~ \lw -> foldl' (flip $ assignHotkey itid) lw hks
| otherwise = | otherwise =
M.foldl' M.foldl'
useHotkey useHotkey
@@ -50,16 +48,13 @@ handleHotkeys w
where where
thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
useHotkey :: World -> (NewInt ItmInt,PressType) -> World useHotkey :: World -> (NewInt ItmInt, PressType) -> World
useHotkey w (NInt itid,pt) = fromMaybe w $ do useHotkey w (NInt itid, pt) = fromMaybe w $ do
invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID invid <- w ^? cWorld . lWorld . itemLocations . ix itid . ilInvID
return $ useItem invid pt w return $ useItem invid pt w
-- cr <- w ^? cWorld . lWorld . creatures . ix 0
-- itmloc <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT
-- return $ heldEffectNoHammerCheck (bimap (^. iatType) (^. _1) itmloc) cr w
allHotkeys :: [SDL.Scancode] --allHotkeys :: [SDL.Scancode]
allHotkeys = map hotkeyToScancode [minBound .. maxBound] --allHotkeys = map hotkeyToScancode [minBound .. maxBound]
hotkeyToScancode :: Hotkey -> SDL.Scancode hotkeyToScancode :: Hotkey -> SDL.Scancode
hotkeyToScancode x = case x of hotkeyToScancode x = case x of
@@ -76,30 +71,21 @@ hotkeyToScancode x = case x of
Hotkey9 -> SDL.Scancode9 Hotkey9 -> SDL.Scancode9
Hotkey0 -> SDL.Scancode0 Hotkey0 -> SDL.Scancode0
scancodeToHotkey :: SDL.Scancode -> Hotkey scancodeToHotkey :: SDL.Scancode -> Maybe Hotkey
scancodeToHotkey x = case x of scancodeToHotkey x = case x of
SDL.ScancodeQ -> HotkeyQ SDL.ScancodeQ -> Just HotkeyQ
SDL.ScancodeE -> HotkeyE SDL.ScancodeE -> Just HotkeyE
SDL.Scancode1 -> Hotkey1 SDL.Scancode1 -> Just Hotkey1
SDL.Scancode2 -> Hotkey2 SDL.Scancode2 -> Just Hotkey2
SDL.Scancode3 -> Hotkey3 SDL.Scancode3 -> Just Hotkey3
SDL.Scancode4 -> Hotkey4 SDL.Scancode4 -> Just Hotkey4
SDL.Scancode5 -> Hotkey5 SDL.Scancode5 -> Just Hotkey5
SDL.Scancode6 -> Hotkey6 SDL.Scancode6 -> Just Hotkey6
SDL.Scancode7 -> Hotkey7 SDL.Scancode7 -> Just Hotkey7
SDL.Scancode8 -> Hotkey8 SDL.Scancode8 -> Just Hotkey8
SDL.Scancode9 -> Hotkey9 SDL.Scancode9 -> Just Hotkey9
SDL.Scancode0 -> Hotkey0 SDL.Scancode0 -> Just Hotkey0
_ -> undefined _ -> Nothing
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
invid <- cr ^? crManipulation . manObject . imSelectedItem
itid <- cr ^? crInv . ix invid . itID
return $ w & cWorld . lWorld %~ assignHotkey itid (scancodeToHotkey sc)
{- | The order of these MAY be important, in particular the setting of crMvAim {- | The order of these MAY be important, in particular the setting of crMvAim
within wasdMovement should probably be done first within wasdMovement should probably be done first
@@ -178,14 +164,18 @@ pressedMBEffectsTopInventory pkeys w
, Just rtime <- pkeys ^? ix SDL.ButtonRight , Just rtime <- pkeys ^? ix SDL.ButtonRight
, ltime <= rtime && inTopInv = , ltime <= rtime && inTopInv =
fromMaybe w $ do fromMaybe w $ do
invid <- w ^? cWorld . lWorld . creatures . ix 0 invid <-
. crManipulation . manObject . imSelectedItem w
^? cWorld . lWorld . creatures . ix 0
. crManipulation
. manObject
. imSelectedItem
return $ useItem invid (f ltime) w return $ useItem invid (f ltime) w
| otherwise = w | otherwise = w
where where
f 0 = InitialPress f 0 = InitialPress
f _ = ShortPress f _ = ShortPress
-- youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown -- youhammerdown = set (cWorld . lWorld . creatures . ix 0 . crHammerPosition) HammerDown
inTopInv = case w ^. hud . hudElement of inTopInv = case w ^. hud . hudElement of
DisplayInventory{_subInventory = NoSubInventory{}} -> True DisplayInventory{_subInventory = NoSubInventory{}} -> True
_ -> False _ -> False
src/Dodge/Data/Item.hs
-1
View File
@@ -41,7 +41,6 @@ data Consumables
data Item = Item data Item = Item
{ _itUse :: ItemUse { _itUse :: ItemUse
, _itUseCondition :: UseCondition , _itUseCondition :: UseCondition
-- , _itUseFocus :: UseFocus
, _itConsumables :: Consumables , _itConsumables :: Consumables
, _itType :: ItemType , _itType :: ItemType
, _itID :: NewInt ItmInt , _itID :: NewInt ItmInt