101 lines
3.9 KiB
Haskell
101 lines
3.9 KiB
Haskell
module Dodge.Creature.YourControl
|
|
where
|
|
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.CreatureAction
|
|
import Dodge.Update.UsingInput
|
|
import Dodge.CreatureState
|
|
import Dodge.Config.KeyConfig
|
|
|
|
import Geometry
|
|
|
|
import Control.Lens
|
|
import qualified SDL
|
|
import qualified Data.Set as S
|
|
import qualified Data.IntMap.Strict as IM
|
|
import System.Random
|
|
|
|
import Data.Maybe
|
|
|
|
|
|
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
|
|
yourControl w (f,g) cr = ( (updateUsingInput . f, g)
|
|
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
|
|
)
|
|
where strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
|
|
speed = _varMovementSpeedModifier w * equipFactor
|
|
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
|
|
|
|
wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature
|
|
wasdWithAiming w speed aimSpeed i cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
|
|
&& diffAngles mouseDir (argV mov) < pi/3
|
|
= over crPos (+.+ (0.2 *.* mov))
|
|
. set crDir mouseDir
|
|
$ set (crState . stance . carriage) (Boosting mov)
|
|
cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving && isAiming
|
|
= set crDir mouseDir
|
|
$ set (crState . stance . carriage) Floating
|
|
cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isMoving
|
|
= over crPos (+.+ (0.2 *.* mov))
|
|
. over crDir (flip fromMaybe dir)
|
|
$ set (crState . stance . carriage) (Boosting mov)
|
|
cr
|
|
| (any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr) && isAiming
|
|
= set (crState . stance . carriage) Floating
|
|
$ set crDir mouseDir
|
|
cr
|
|
| any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
|
|
= set (crState . stance . carriage) Floating
|
|
cr
|
|
| isAiming
|
|
= stepForward' aimSpeed
|
|
$ over crPos (+.+ (aimSpeed *.* mov))
|
|
$ set crDir mouseDir
|
|
cr
|
|
| isMoving
|
|
= stepForward' speed
|
|
$ over ( crPos) (+.+ (speed *.* mov))
|
|
$ over ( crDir) (flip fromMaybe dir)
|
|
cr
|
|
| otherwise
|
|
= over ( crDir) (flip fromMaybe dir)
|
|
cr
|
|
where (mov',dir') = wasdComp (view keys w) w
|
|
(mov,dir) = (rotateV (_cameraRot w) mov',fmap (_cameraRot w +) dir')
|
|
isMoving = mov' /= (0,0)
|
|
isAiming = (_posture $ _stance $ _crState cr) == Aiming
|
|
mouseDir = case w ^? creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
|
|
. itAttachment of
|
|
Just (Just (ItScope {_scopePos = p})) -> normalizeAngle $ argV
|
|
$ p +.+ 2 / _cameraZoom w
|
|
*.* rotateV (_cameraRot w) (_mousePos w)
|
|
_ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
|
|
|
|
|
|
wasdM :: World -> SDL.Scancode -> Point2
|
|
wasdM w scancode
|
|
| scancode == moveUpKey (_keyConfig w) = (0,1)
|
|
| scancode == moveDownKey (_keyConfig w) = (0,-1)
|
|
| scancode == moveRightKey (_keyConfig w) = (1,0)
|
|
| scancode == moveLeftKey (_keyConfig w) = (-1,0)
|
|
wasdM _ _ = (0,0)
|
|
|
|
wasdComp :: S.Set SDL.Scancode -> World -> (Point2,Maybe Float)
|
|
wasdComp ks w = f $ foldr ( (+.+) . wasdM w ) (0,0) ks
|
|
where f (0,0) = ((0,0), Nothing)
|
|
f p = (errorNormalizeV 46 p, Just $ argV p)
|
|
|
|
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
|
|
mouseActionsCr keys cr
|
|
| rbPressed
|
|
= set ( crState . stance . posture) Aiming cr
|
|
| otherwise
|
|
= set ( crState . stance . posture) AtEase cr
|
|
where lbPressed = SDL.ButtonLeft `S.member` keys
|
|
rbPressed = SDL.ButtonRight `S.member` keys
|
|
|