132 lines
4.8 KiB
Haskell
132 lines
4.8 KiB
Haskell
module Dodge.Creature.YourControl (
|
|
yourControl,
|
|
) where
|
|
|
|
import Dodge.Base.You
|
|
import Dodge.Creature.Impulse.UseItem
|
|
import Data.Foldable
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Dodge.Base.Coordinate
|
|
import Dodge.Creature.Impulse.Movement
|
|
import Dodge.Creature.Test
|
|
import Dodge.Data.World
|
|
import Dodge.InputFocus
|
|
import Geometry
|
|
import LensHelp
|
|
import qualified SDL
|
|
|
|
-- | The AI equivalent for your control.
|
|
yourControl :: Creature -> World -> World
|
|
yourControl cr w
|
|
| inInputFocus w = w
|
|
| 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)))
|
|
& pressedMBEffectsNoInventory pkeys
|
|
where
|
|
pkeys = w ^. input . mouseButtons
|
|
intopinv = fromMaybe False $ do
|
|
subinv <- w ^? hud . hudElement . subInventory
|
|
Just $ case subinv of
|
|
NoSubInventory -> True
|
|
_ -> False
|
|
|
|
--dimCreatureLight :: Creature -> World -> World
|
|
--dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
|
|
|
|
-- note the order of operation, setting the posture first--this prevents the twist fire bug
|
|
|
|
-- | Turn key presses into creature movement.
|
|
wasdWithAiming ::
|
|
World ->
|
|
-- | Base speed
|
|
Float ->
|
|
Creature ->
|
|
Creature
|
|
wasdWithAiming w speed cr
|
|
| isAiming = addAnyTwist $ aimTurn mouseDir $ theMovement $ setMvAim cr
|
|
| crIsReloading cr && SDL.ButtonRight `M.member` _mouseButtons (_input w) =
|
|
aimTurn mouseDir $ removeTwist $ theMovement $ setMvAim cr
|
|
| otherwise = noaimmove $ theTurn $ removeTwist $ setMvAim cr
|
|
where
|
|
setMvAim = maybe id (crMvAim .~) dir
|
|
twistamount = 1.6
|
|
removeTwist cr' =
|
|
cr'
|
|
& crDir +~ _crTwist cr'
|
|
& crTwist .~ 0
|
|
addAnyTwist = fromMaybe id $ do
|
|
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)
|
|
_ -> Nothing
|
|
theMovement
|
|
| movDir == V2 0 0 = id
|
|
| otherwise = crMvAbsolute (speed *.* movAbs)
|
|
noaimmove
|
|
| movDir == V2 0 0 = id
|
|
| otherwise = crMvForward speed
|
|
theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
|
|
movDir = wasdDir w
|
|
dir = fmap ((w ^. cWorld . camPos . camRot) +) (safeArgV movDir)
|
|
movAbs = rotateV (w ^. cWorld . camPos . camRot) $ normalizeV movDir
|
|
isAiming = _posture (_crStance cr) == Aiming
|
|
mouseDir = fromMaybe
|
|
(argV (_mousePos (_input w)) + (w ^. cWorld . camPos . camRot) )
|
|
$ do
|
|
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
_ <- cr ^? crInv . ix itRef . itScope . scopePos
|
|
return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . camPos) -.- _crPos cr
|
|
|
|
aimTurn :: Float -> Creature -> Creature
|
|
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
|
|
where
|
|
x = fromMaybe 1 $ do
|
|
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
|
|
cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed
|
|
|
|
wasdM :: SDL.Scancode -> Point2
|
|
wasdM scancode = case scancode of
|
|
SDL.ScancodeW -> V2 0 1
|
|
SDL.ScancodeS -> V2 0 (-1)
|
|
SDL.ScancodeD -> V2 1 0
|
|
SDL.ScancodeA -> V2 (-1) 0
|
|
_ -> V2 0 0
|
|
|
|
wasdDir :: World -> Point2
|
|
wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _input
|
|
|
|
-- | Set posture according to mouse presses.
|
|
mouseActionsCr :: M.Map SDL.MouseButton Bool -> Creature -> Creature
|
|
mouseActionsCr pkeys cr
|
|
| rbPressed && noaction =
|
|
cr & crStance . posture .~ Aiming
|
|
| otherwise = cr & crStance . posture .~ AtEase
|
|
where
|
|
rbPressed = SDL.ButtonRight `M.member` pkeys
|
|
noaction = fromMaybe True $ do
|
|
theaction <- cr ^? crManipulation . manObject . inInventory . iselAction
|
|
return $ theaction == NoInvSelAction
|
|
|
|
pressedMBEffectsNoInventory :: M.Map SDL.MouseButton Bool -> World -> World
|
|
pressedMBEffectsNoInventory pkeys w
|
|
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w
|
|
| isDown SDL.ButtonLeft && inTopInv = useLeftItem 0 w
|
|
| isDown SDL.ButtonMiddle =
|
|
w & cWorld . camPos . camRot -~ rotation
|
|
& input . clickMousePos .~ _mousePos (_input w)
|
|
| otherwise = w
|
|
where
|
|
inTopInv = case w ^. hud . hudElement of
|
|
DisplayInventory {_subInventory = NoSubInventory} -> True
|
|
_ -> False
|
|
isDown but = but `M.member` pkeys
|
|
rotation = angleBetween (_mousePos (_input w)) (_clickMousePos (_input w))
|