Files
loop/src/Dodge/Creature/YourControl.hs
T
2021-11-28 16:53:26 +00:00

70 lines
2.2 KiB
Haskell

module Dodge.Creature.YourControl
( yourControl
) where
import Dodge.Data
import Dodge.Creature.Impulse.Movement
import Dodge.Update.UsingInput
--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 Data.Monoid
{- | The AI equivalent for your control. -}
yourControl
:: Creature
-> World
-> (Endo World, Maybe Creature)
yourControl cr w =
( Endo updateUsingInput
, Just . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
)
where
speed = _mvSpeed $ _crMvType cr
{- | 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 $ theMovement cr
| otherwise = theMovement $ theTurn cr
where
theMovement
| movDir == V2 0 0 = id
| otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir
theTurn cr' = creatureTurnTowardDir (_crMvDir cr') 0.2 cr'
movDir = wasdDir w
dir = _cameraRot w + argV movDir
movAbs = rotateV (_cameraRot w) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case w ^? creatures . ix i . crInv . ix (_crInvSel (_creatures w IM.! i))
. itAttachment of
Just ItScope{_scopePos = p} -> normalizeAngle $ argV
$ p +.+ 2 / _cameraZoom w
*.* rotateV (_cameraRot w) (_mousePos w)
_ -> normalizeAngle $ argV (_mousePos w) + _cameraRot w
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 w = foldr ((+.+) . wasdM) (V2 0 0) $ _keys w
{- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
mouseActionsCr pkeys
| rbPressed = crStance . posture .~ Aiming
| otherwise = crStance . posture .~ AtEase
where
rbPressed = SDL.ButtonRight `S.member` pkeys