loop/src/Dodge/Creature/YourControl.hs

{-# LANGUAGE LambdaCase #-}

module Dodge.Creature.YourControl (yourControl) where

import Control.Monad
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.SelectedClose
import Dodge.WASD
import Geometry
import LensHelp
import Linear
import NewInt
import qualified SDL

-- | The AI equivalent for your control.
yourControl :: World -> World
yourControl w
    | inTextInputFocus w = w
    | NoSubInventory <- w ^. hud . subInventory =
        w
            & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w
            & tryClickUse (w ^. input . mouseButtons)
            & handleHotkeys
    | otherwise = w & cWorld . lWorld . creatures . ix 0 %~ wasdWithAiming w

-- 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 (Sel 0 invid) <- w ^. hud .diSelection
    , Just itid <- lw ^? creatures . ix 0 . crInv . ix (NInt 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 pressedhotkeys
  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
    pressedhotkeys = M.intersectionWith (,) thehotkeys (w ^. input . pressedKeys)

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 
    | Walking <- cr ^. crStance . carriage 
        = wasdAim inp w $ wasdMovement w inp cam speed cr
    | otherwise = cr
  where
    speed = _mvSpeed $ crMvType cr
    inp = w ^. input
    cam = w ^. wCam

wasdAim :: Input -> World -> Creature -> Creature
wasdAim inp w cr
    | SDL.ButtonRight `M.member` _mouseButtons inp
    , AtEase <- cr ^. crStance . posture = setposture Aiming (-twistAmount)
    | SDL.ButtonRight `M.member` _mouseButtons inp = aimTurn w mousedir cr
    | Aiming{} <- cr ^. crStance . posture = setposture AtEase twistAmount
    | otherwise = creatureTurnTowardDir (_crMvDir cr) 0.2 cr
  where
    setposture x r =
        cr
            & crStance . posture .~ x
            & doAimTwist (w ^? hud . manObject . hiAimStance) r
    mousedir = argV $ w ^. cWorld . lWorld . lAimPos - (cr ^. crPos . _xy)

doAimTwist :: Maybe AimStance -> Float -> Creature -> Creature
doAimTwist as x
    | as == Just TwoHandTwist = crDir +~ x
    | otherwise = id

twistAmount :: Float
twistAmount = 1.6 * pi

wasdMovement :: World -> Input -> Camera -> Float -> Creature -> Creature
wasdMovement w 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 w (speed *^ movAbs)

aimTurn :: World -> Float -> Creature -> Creature
aimTurn lw a cr = creatureTurnTowardDir a (x * 0.2) cr
  where
    x = fromMaybe 1 $ do
        itRef <- lw ^? hud . manObject . hiRootSelectedItem
        fmap itemBulkiness $ cr ^? crInv . ix itRef >>= \k -> lw ^?cWorld.lWorld. 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
    TESLACOIL -> 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 ^.hud.diSelection of
        Just (Sel 0 invid) -> useItem invid ltime w
        _ -> interactWithCloseObj <$> getSelectedCloseObj w ?? w