Files
loop/src/Dodge/Creature/YourControl.hs
T

76 lines
2.7 KiB
Haskell

module Dodge.Creature.YourControl
where
import Dodge.Data
import Dodge.Base
import Dodge.Creature.Action
import Dodge.Creature.State
import Dodge.Creature.State.Data
import Dodge.Creature.Stance.Data
import Dodge.Update.UsingInput
import Dodge.Config.KeyConfig
import Dodge.Item.Attachment.Data
import Geometry
import Control.Lens
import qualified SDL
import Data.Maybe
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import System.Random
{- | The AI equivalent for your control. -}
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
yourControl w (f,g) cr =
( (updateUsingInput . f, g)
, Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
)
where
speed = _varMovementSpeedModifier w * equipFactor
equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0
{- | Turn key presses into creature movement. -}
wasdWithAiming
:: World
-> Float -- ^ Base speed
-> Int -- ^ Creature id
-> Creature
-> Creature
wasdWithAiming w speed i cr
| isAiming = set crDir mouseDir $ crMvBy (speed *.* mov) cr
| isMoving = crMvForward speed $ over crDir (`fromMaybe` dir) cr
| otherwise = cr
where
(mov',dir') = wasdComp (view keys w) w
dir = fmap (_cameraRot w +) dir'
mov = rotateV (negate $ _crDir cr) mov'
isAiming = _posture (_crStance cr) == Aiming
isMoving = mov' /= (0,0)
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)
{- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
mouseActionsCr keys
| rbPressed = crStance . posture .~ Aiming
| otherwise = crStance . posture .~ AtEase
where
lbPressed = SDL.ButtonLeft `S.member` keys
rbPressed = SDL.ButtonRight `S.member` keys