250 lines
7.6 KiB
Haskell
250 lines
7.6 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Creature.YourControl (yourControl) where
|
|
|
|
import Linear
|
|
import Control.Monad
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Dodge.AssignHotkey
|
|
import Dodge.Creature.Impulse.Movement
|
|
import Dodge.Creature.Impulse.UseItem
|
|
import Dodge.Creature.MoveType
|
|
import Dodge.Data.AimStance
|
|
import Dodge.Data.Equipment.Misc
|
|
import Dodge.Data.World
|
|
import Dodge.InputFocus
|
|
import Dodge.Inventory
|
|
import Dodge.Item.AimStance
|
|
import Dodge.SelectedClose
|
|
import Dodge.WASD
|
|
import Geometry
|
|
import LensHelp
|
|
import NewInt
|
|
import qualified SDL
|
|
|
|
-- | The AI equivalent for your control.
|
|
yourControl :: Creature -> World -> World
|
|
yourControl _ w
|
|
| inTextInputFocus w = w
|
|
| Just x <- w ^? hud . subInventory
|
|
, f x =
|
|
w
|
|
& cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
|
|
& tryClickUse pkeys
|
|
& handleHotkeys
|
|
| otherwise = w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
|
|
where
|
|
f = \case
|
|
NoSubInventory -> True
|
|
ExamineInventory -> True
|
|
_ -> False
|
|
pkeys = w ^. input . mouseButtons
|
|
|
|
-- the following only works because modifier keys are ordered after scancode "hotkeys"
|
|
handleHotkeys :: World -> World
|
|
handleHotkeys w
|
|
| ispressed SDL.ScancodeLShift || ispressed SDL.ScancodeRShift
|
|
, (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
|
|
, Just invid <- lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
|
|
, Just itid <- lw ^? creatures . ix 0 . crInv . ix invid =
|
|
w & cWorld . lWorld %~ assignHotkey (NInt itid) hk
|
|
| ispressed SDL.ScancodeLCtrl || ispressed SDL.ScancodeRCtrl
|
|
, (hk:_) <- mapMaybe scancodeToHotkey . M.keys $ pkeys
|
|
, Just itid <- lw ^? hotkeys . ix hk . unNInt
|
|
, Just invid <- lw ^? items . ix itid . itLocation . ilInvID =
|
|
w & invSetSelectionPos 0 (_unNInt invid)
|
|
| otherwise =
|
|
M.foldl'
|
|
useHotkey
|
|
w
|
|
(M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys))
|
|
where
|
|
pkeys = w ^. input . pressedKeys
|
|
ispressed k = k `M.member` _pressedKeys (_input w)
|
|
thehotkeys = M.mapKeys hotkeyToScancode $ w ^. cWorld . lWorld . hotkeys
|
|
lw = w ^. cWorld . lWorld
|
|
|
|
--modifierKeys :: S.Set SDL.Scancode
|
|
--modifierKeys = S.fromList
|
|
-- [ SDL.ScancodeLShift
|
|
-- , SDL.ScancodeRShift
|
|
-- , SDL.ScancodeRCtrl
|
|
-- , SDL.ScancodeLCtrl
|
|
-- ]
|
|
|
|
useHotkey :: World -> (NewInt ItmInt, Int) -> World
|
|
useHotkey w (NInt itid, pt) = fromMaybe w $ do
|
|
invid <- w ^? cWorld . lWorld . items . ix itid . itLocation . ilInvID . unNInt
|
|
useItem invid pt w
|
|
|
|
hotkeyToScancode :: Hotkey -> SDL.Scancode
|
|
hotkeyToScancode = \case
|
|
HotkeyQ -> SDL.ScancodeQ
|
|
HotkeyE -> SDL.ScancodeE
|
|
HotkeyR -> SDL.ScancodeE
|
|
HotkeyZ -> SDL.ScancodeZ
|
|
HotkeyX -> SDL.ScancodeX
|
|
HotkeyC -> SDL.ScancodeC
|
|
HotkeyV -> SDL.ScancodeV
|
|
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 -> Maybe Hotkey
|
|
scancodeToHotkey = \case
|
|
SDL.ScancodeQ -> Just HotkeyQ
|
|
SDL.ScancodeE -> Just HotkeyE
|
|
SDL.ScancodeR -> Just HotkeyR
|
|
SDL.ScancodeZ -> Just HotkeyZ
|
|
SDL.ScancodeX -> Just HotkeyX
|
|
SDL.ScancodeC -> Just HotkeyC
|
|
SDL.ScancodeV -> Just HotkeyV
|
|
SDL.Scancode1 -> Just Hotkey1
|
|
SDL.Scancode2 -> Just Hotkey2
|
|
SDL.Scancode3 -> Just Hotkey3
|
|
SDL.Scancode4 -> Just Hotkey4
|
|
SDL.Scancode5 -> Just Hotkey5
|
|
SDL.Scancode6 -> Just Hotkey6
|
|
SDL.Scancode7 -> Just Hotkey7
|
|
SDL.Scancode8 -> Just Hotkey8
|
|
SDL.Scancode9 -> Just Hotkey9
|
|
SDL.Scancode0 -> Just Hotkey0
|
|
_ -> Nothing
|
|
|
|
{- | The order of these MAY be important, in particular the setting of crMvAim
|
|
within wasdMovement should probably be done first
|
|
-}
|
|
wasdWithAiming :: World -> Creature -> Creature
|
|
wasdWithAiming w cr = wasdAim inp w $ wasdMovement (w ^. cWorld . lWorld) inp cam speed cr
|
|
where
|
|
speed = _mvSpeed $ crMvType cr
|
|
inp = w ^. input
|
|
cam = w ^. wCam
|
|
|
|
wasdAim :: Input -> World -> Creature -> Creature
|
|
wasdAim inp w cr
|
|
| Just 0 <- inp ^? mouseButtons . ix SDL.ButtonRight
|
|
, Nothing <- inp ^? mouseButtons . ix SDL.ButtonLeft =
|
|
setAimPosture (w ^. cWorld . lWorld . items) cr
|
|
| SDL.ButtonRight `M.member` _mouseButtons inp =
|
|
aimTurn (w ^. cWorld . lWorld) mousedir cr
|
|
| Aiming {} <- cr ^. crStance . posture = removeAimPosture cr
|
|
| otherwise = creatureTurnTowardDir (_crMvAim cr) 0.2 cr
|
|
where
|
|
mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)
|
|
|
|
setAimPosture :: IM.IntMap Item -> Creature -> Creature
|
|
setAimPosture m cr = fromMaybe cr $ do
|
|
invid <- cr ^? crManipulation . manObject . imRootSelectedItem
|
|
itid <- cr ^? crInv . ix invid
|
|
as <- fmap itemBaseStance $ m ^? ix itid
|
|
return $ cr
|
|
& crStance . posture .~ Aiming as
|
|
& doAimTwist as (- twoHandTwistAmount)
|
|
|
|
doAimTwist :: AimStance -> Float -> Creature -> Creature
|
|
doAimTwist as x
|
|
| as == TwoHandOver || as == TwoHandUnder = crDir +~ x
|
|
| otherwise = id
|
|
|
|
removeAimPosture :: Creature -> Creature
|
|
removeAimPosture cr = fromMaybe cr $ do
|
|
as <- cr ^? crStance . posture . aimStance
|
|
return $ cr
|
|
& crStance . posture .~ AtEase
|
|
& doAimTwist as twoHandTwistAmount
|
|
|
|
twoHandTwistAmount :: Float
|
|
twoHandTwistAmount = 1.6 * pi
|
|
|
|
wasdMovement :: LWorld -> Input -> Camera -> Float -> Creature -> Creature
|
|
wasdMovement lw inp cam speed = theMovement . setMvAim
|
|
where
|
|
setMvAim = fromMaybe id $ do
|
|
dir <- safeArgV movDir
|
|
return $ crMvAim .~ (cam ^. camRot + dir)
|
|
movDir = wasdDir inp
|
|
movAbs = rotateV (cam ^. camRot) $ normalizeV movDir
|
|
theMovement
|
|
| movDir == V2 0 0 = id
|
|
| otherwise = crMvAbsolute lw (speed *.* movAbs)
|
|
|
|
aimTurn :: LWorld -> Float -> Creature -> Creature
|
|
aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
|
|
where
|
|
x = fromMaybe 1 $ do
|
|
itRef <- cr ^? crManipulation . manObject . imRootSelectedItem
|
|
fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^? items . ix k . itType
|
|
|
|
itemBulkiness :: ItemType -> Float
|
|
itemBulkiness = \case
|
|
HELD hit -> heldItemBulkiness hit
|
|
LASER -> 1
|
|
_ -> 1
|
|
|
|
heldItemBulkiness :: HeldItemType -> Float
|
|
heldItemBulkiness = \case
|
|
BANGSTICK{} -> 1
|
|
REWINDER -> 1
|
|
TIMESTOPPER -> 1
|
|
TIMESCROLLER -> 1
|
|
PISTOL -> 1
|
|
MACHINEPISTOL -> 1
|
|
AUTOPISTOL -> 1
|
|
SMG -> 1
|
|
BANGCONE -> 1
|
|
BLUNDERBUSS -> 1
|
|
GRAPECANNON{} -> 1
|
|
MINIGUNX{} -> 0.5
|
|
VOLLEYGUN{} -> 1
|
|
RIFLE -> 1
|
|
ALTERIFLE -> 1
|
|
AUTORIFLE -> 1
|
|
BURSTRIFLE -> 1
|
|
BANGROD -> 1
|
|
ELEPHANTGUN -> 1
|
|
AMR -> 1
|
|
AUTOAMR -> 1
|
|
SNIPERRIFLE -> 1
|
|
FLAMESPITTER -> 1
|
|
FLAMETHROWER -> 1
|
|
FLAMETORRENT -> 1
|
|
FLAMEWALL -> 1
|
|
BLOWTORCH -> 1
|
|
SPARKGUN -> 1
|
|
TESLAGUN -> 1
|
|
TRACTORGUN -> 1
|
|
RLAUNCHER -> 0.9
|
|
RLAUNCHERX{} -> 0.9
|
|
GLAUNCHER -> 1
|
|
POISONSPRAYER -> 1
|
|
SHATTERGUN -> 1
|
|
LED -> 1
|
|
FLATSHIELD -> 0.5
|
|
KEYCARD{} -> 1
|
|
BLINKER -> 1
|
|
BLINKERUNSAFE -> 1
|
|
|
|
tryClickUse :: M.Map SDL.MouseButton Int -> World -> World
|
|
tryClickUse pkeys w = fromMaybe w $ do
|
|
ltime <- pkeys ^? ix SDL.ButtonLeft
|
|
rtime <- pkeys ^? ix SDL.ButtonRight
|
|
guard $ ltime <= rtime
|
|
case w
|
|
^? cWorld . lWorld . creatures . ix 0
|
|
. crManipulation
|
|
. manObject
|
|
. imSelectedItem
|
|
. unNInt of
|
|
Just invid -> useItem invid ltime w
|
|
Nothing -> interactWithCloseObj <$> getSelectedCloseObj w ?? w
|