Cleanup, stop assigning hotkeys to unequipped items

This commit is contained in:
2023-05-05 01:59:40 +01:00
parent aeefbd4c40
commit 031af611cd
13 changed files with 227 additions and 215 deletions
+6 -17
View File
@@ -2,8 +2,10 @@ module Dodge.Creature.Impulse.UseItem (
useItem,
doTopInvLeftClick,
itemEffect,
tryUseL,
) where
import Dodge.Hotkey
import Control.Lens
import Control.Monad
import Data.Foldable
@@ -50,7 +52,6 @@ itemEffect cr it w = case it ^. itUse of
setuhamdown $
hammerTest
( toggleEquipmentAt (_rbOptions w) itRef cr
. activateEquipmentAt (_rbOptions w) cr
)
tryReload :: Creature -> Item -> Input -> (World -> World) -> World -> World
@@ -68,13 +69,6 @@ itNeedsLoading it = _laLoaded ic == 0 || not (_laPrimed ic)
where
ic = _heldConsumption (_itUse it)
activateEquipmentAt :: RightButtonOptions -> Creature -> World -> World
activateEquipmentAt rbo cr =
cWorld . lWorld . creatures . ix (_crID cr) %~ case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
(Just i, _) -> crLeftInvSel . lisMPos ?~ i
(_, Just _) -> crLeftInvSel . lisMPos .~ Nothing
_ -> id
toggleEquipmentAt :: RightButtonOptions -> Int -> Creature -> World -> World
toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
Just DoNotMoveEquipment -> w
@@ -83,6 +77,7 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
& crpoint . crEquipment . at newp ?~ invid
& crpoint . crInvEquipped . at invid ?~ newp
& onequip itm cr
& assignNewHotkey invid
Just MoveEquipment{_allocNewPos = newp, _allocOldPos = oldp} ->
w
& crpoint . crEquipment . at newp ?~ invid
@@ -101,11 +96,14 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
& crpoint . crInvEquipped . at rid .~ Nothing
& onremove (itmat rid) cr
& onequip itm cr
& crpoint %~ removeHotkey rid
& assignNewHotkey invid
Just RemoveEquipment{_allocOldPos = oldp} ->
w
& crpoint . crEquipment . at oldp .~ Nothing
& crpoint . crInvEquipped . at invid .~ Nothing
& onremove itm cr
& crpoint %~ removeHotkey invid
Nothing -> error "tried to toggle equipment when not prepared"
where
crpoint = cWorld . lWorld . creatures . ix (_crID cr)
@@ -118,10 +116,6 @@ toggleEquipmentAt rbops invid cr w = case rbops ^? opAllocateEquipment of
doTopInvLeftClick :: Creature -> World -> World
doTopInvLeftClick cr w = fromMaybe w $ do
guard . not $ _crInvLock cr
return $ doTopInvLeftClick' cr w
doTopInvLeftClick' :: Creature -> World -> World
doTopInvLeftClick' cr w = fromMaybe (doTopInvLeftClickSearch cr w) $ do
invid <- cr ^? crManipulation . manObject . inInventory . ispItem
ituse <- cr ^? crInv . ix invid . itUse
case ituse of
@@ -136,11 +130,6 @@ equipAndUse useonequip invid cr w = case cr ^? crInvEquipped . ix invid of
| otherwise -> useItem cr w
_ -> tryUseL (_crID cr) invid w
doTopInvLeftClickSearch :: Creature -> World -> World
doTopInvLeftClickSearch cr w = fromMaybe w $ do
invid <- cr ^. crLeftInvSel . lisMPos
return $ tryUseL (_crID cr) invid w
tryUseL :: Int -> Int -> World -> World
tryUseL crid invid w = fromMaybe w $ do
cr <- w ^? cWorld . lWorld . creatures . ix crid
+2 -2
View File
@@ -56,7 +56,7 @@ setMvPos w cr = cr & crIntention . mvToPoint .~ mpos
mtpos = do
tpos <- _crPos <$> _targetCr int
guard $ hasLOSIndirect (_crPos cr) tpos w
return $ tpos
return tpos
mpos = mtpos <|> _mvToPoint int
setViewPos :: World -> Creature -> Creature
@@ -67,7 +67,7 @@ setViewPos w cr = cr & crIntention . viewPoint %~ ((<|> mpos) . (attentionViewPo
attentionViewPoint :: World -> Creature -> Maybe Point2
attentionViewPoint w cr = do
attention <- cr ^? crPerception . cpAttention . getAttentiveTo
cid <- (sortOn snd $ IM.toList attention) ^? ix 0 . _1
cid <- sortOn snd (IM.toList attention) ^? ix 0 . _1
tcr <- w ^? cWorld . lWorld . creatures . ix cid
guard $ visionCheck cr (_crPos tcr) > 0
return (_crPos tcr)
+73 -17
View File
@@ -2,16 +2,19 @@ module Dodge.Creature.YourControl (
yourControl,
) where
import Dodge.WASD
import Dodge.Base.You
import Dodge.Creature.Impulse.UseItem
import Dodge.Hotkey
import Control.Monad
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Base.You
import Dodge.Creature.Impulse.Movement
import Dodge.Creature.Test
import Dodge.Data.World
import Dodge.InputFocus
import Dodge.WASD
import Geometry
import LensHelp
import qualified SDL
@@ -20,13 +23,15 @@ import qualified SDL
yourControl :: Creature -> World -> World
yourControl cr w
| inInputFocus w = w
| not intopinv = w & cWorld . lWorld . creatures . ix (_crID cr)
%~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
| not intopinv =
w & cWorld . lWorld . creatures . ix (_crID cr)
%~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
| otherwise =
w
& cWorld . lWorld . creatures . ix (_crID cr)
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
& pressedMBEffectsTopInventory pkeys
& handleHotkeys
where
pkeys = w ^. input . mouseButtons
intopinv = fromMaybe False $ do
@@ -35,12 +40,60 @@ yourControl cr w
NoSubInventory -> True
_ -> False
--dimCreatureLight :: Creature -> World -> World
--dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
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))
where
hotkeys = M.mapKeys hotkeyToScancode $ w ^?! cWorld . lWorld . creatures . ix 0 . crHotkeys
-- note the order of operation, setting the posture first--this prevents the twist fire bug
useHotKey :: World -> Int -> World
useHotKey w invid = tryUseL 0 invid w
allHotkeys :: [SDL.Scancode]
allHotkeys = map hotkeyToScancode [minBound .. maxBound]
hotkeyToScancode :: Hotkey -> SDL.Scancode
hotkeyToScancode x = case x of
HotkeyQ -> SDL.ScancodeQ
HotkeyE -> SDL.ScancodeE
Hotkey1 -> SDL.Scancode1
Hotkey2 -> SDL.Scancode2
Hotkey3 -> SDL.Scancode3
Hotkey4 -> SDL.Scancode4
Hotkey5 -> SDL.Scancode5
Hotkey6 -> SDL.Scancode6
Hotkey7 -> SDL.Scancode7
Hotkey8 -> SDL.Scancode8
Hotkey9 -> SDL.Scancode9
Hotkey0 -> SDL.Scancode0
scancodeToHotkey :: SDL.Scancode -> Hotkey
scancodeToHotkey x = case x of
SDL.ScancodeQ -> HotkeyQ
SDL.ScancodeE -> HotkeyE
SDL.Scancode1 -> Hotkey1
SDL.Scancode2 -> Hotkey2
SDL.Scancode3 -> Hotkey3
SDL.Scancode4 -> Hotkey4
SDL.Scancode5 -> Hotkey5
SDL.Scancode6 -> Hotkey6
SDL.Scancode7 -> Hotkey7
SDL.Scancode8 -> Hotkey8
SDL.Scancode9 -> Hotkey9
SDL.Scancode0 -> Hotkey0
_ -> undefined
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
itid <- cr ^? crManipulation . manObject . inInventory . ispItem
return $ assignHotkey itid (scancodeToHotkey sc) w
-- | Turn key presses into creature movement.
-- | note the order of operation, setting the posture first--this prevents the twist fire bug
wasdWithAiming ::
World ->
-- | Base speed
@@ -63,9 +116,11 @@ wasdWithAiming w speed cr
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
astance <- cr ^? crInv . ix itRef . itUse . heldAim . aimStance
let currenttwistamount = cr ^. crTwist
case (astance,currenttwistamount) of
( TwoHandTwist, 0) -> return $ (crTwist .~ twistamount * pi)
. (crDir -~ twistamount * pi)
case (astance, currenttwistamount) of
(TwoHandTwist, 0) ->
return $
(crTwist .~ twistamount * pi)
. (crDir -~ twistamount * pi)
_ -> Nothing
theMovement
| movDir == V2 0 0 = id
@@ -78,8 +133,8 @@ wasdWithAiming w speed cr
dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. wCam . camRot) )
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. wCam . camRot))
$ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
_ <- cr ^? crInv . ix itRef . itScope . scopePos
@@ -92,7 +147,6 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
-- | Set posture according to mouse presses.
mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature
mouseActionsCr pkeys cr
@@ -114,10 +168,12 @@ pressedMBEffectsTopInventory pkeys w
| otherwise = w
where
inTopInv = case w ^. hud . hudElement of
DisplayInventory {_subInventory = NoSubInventory} -> True
DisplayInventory{_subInventory = NoSubInventory} -> True
_ -> False
isDown but = but `M.member` pkeys
theinput = w ^. input
rotation = maybe 0
(angleBetween (theinput ^. mousePos))
(theinput ^. heldPos . at SDL.ButtonMiddle)
rotation =
maybe
0
(angleBetween (theinput ^. mousePos))
(theinput ^. heldPos . at SDL.ButtonMiddle)