This commit is contained in:
2022-04-07 20:54:00 +01:00
parent 591cff68ff
commit 9d4b1d5d70
3 changed files with 45 additions and 63 deletions
+4 -5
View File
@@ -67,8 +67,7 @@ spawnerCrit = defaultCreature
miniGunCrit :: Creature miniGunCrit :: Creature
miniGunCrit = defaultCreature miniGunCrit = defaultCreature
{ _crPict = basicCrPict red { _crPict = basicCrPict red
, _crUpdate = defaultImpulsive $ , _crUpdate = defaultImpulsive [sentinelFireType (const shootTillEmpty)]
[sentinelFireType (const shootTillEmpty)]
, _crActionPlan = ActionPlan , _crActionPlan = ActionPlan
{ _crImpulse = [] { _crImpulse = []
, _crAction = [] , _crAction = []
@@ -88,7 +87,7 @@ longCrit :: Creature
longCrit = defaultCreature longCrit = defaultCreature
{ _crPict = basicCrPict red { _crPict = basicCrPict red
-- , _crUpdate = stateUpdate sniperAI -- , _crUpdate = stateUpdate sniperAI
, _crUpdate = defaultImpulsive $ [sentinelFireType $ const shootTillEmpty] , _crUpdate = defaultImpulsive [sentinelFireType $ const shootTillEmpty]
, _crActionPlan = ActionPlan , _crActionPlan = ActionPlan
{ _crImpulse = [] { _crImpulse = []
, _crAction = [] , _crAction = []
@@ -108,7 +107,7 @@ multGunCrit = defaultCreature
, _crInvSel = 0 , _crInvSel = 0
, _crRad = 10 , _crRad = 10
, _crHP = 300 , _crHP = 300
, _crUpdate = defaultImpulsive $ [sentinelExtraWatchUpdate , _crUpdate = defaultImpulsive [sentinelExtraWatchUpdate
[ ( const $ not . crHasAmmo [ ( const $ not . crHasAmmo
, \_ _ -> StrategyActions Reload reloadActions , \_ _ -> StrategyActions Reload reloadActions
) )
@@ -150,7 +149,7 @@ startCr = defaultCreature
, _crMvDir = pi/2 , _crMvDir = pi/2
, _crID = 0 , _crID = 0
, _crPict = basicCrPict black , _crPict = basicCrPict black
, _crUpdate = stateUpdate' yourControl' , _crUpdate = stateUpdate' yourControl
, _crRad = 10 , _crRad = 10
, _crMass = 10 , _crMass = 10
, _crHP = 1000 , _crHP = 1000
+18 -34
View File
@@ -1,6 +1,5 @@
module Dodge.Creature.YourControl module Dodge.Creature.YourControl
(-- yourControl ( yourControl
yourControl'
) where ) where
import Dodge.Data import Dodge.Data
import Dodge.Creature.Impulse.Movement import Dodge.Creature.Impulse.Movement
@@ -11,23 +10,13 @@ import Geometry
import Control.Lens import Control.Lens
import qualified SDL import qualified SDL
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM --import qualified Data.IntMap.Strict as IM
import Data.Maybe import Data.Maybe
{- | The AI equivalent for your control. -} {- | The AI equivalent for your control. -}
yourControl yourControl :: Creature -> World -> World
:: Creature yourControl cr w = w
-> World
-> (World -> World, Creature)
yourControl cr w =
( updateUsingInput
, mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed 0 cr
)
where
speed = _mvSpeed $ _crMvType cr
yourControl' :: Creature -> World -> World
yourControl' cr w = w
& updateUsingInput & updateUsingInput
& creatures . ix (_crID cr) %~ (mouseActionsCr (_mouseButtons w) . wasdWithAiming w speed 0) & creatures . ix (_crID cr) %~ (mouseActionsCr (_mouseButtons w) . wasdWithAiming w speed)
where where
speed = _mvSpeed $ _crMvType cr speed = _mvSpeed $ _crMvType cr
@@ -35,26 +24,22 @@ yourControl' cr w = w
wasdWithAiming wasdWithAiming
:: World :: World
-> Float -- ^ Base speed -> Float -- ^ Base speed
-> Int -- ^ Creature id
-> Creature -> Creature
-> Creature -> Creature
wasdWithAiming w speed i cr wasdWithAiming w speed cr
| isAiming | isAiming = addAnyTwist $ set crDir mouseDir $ theMovement cr
= addAnyTwist $ set crDir mouseDir $ theMovement cr
| isReloading && SDL.ButtonRight `S.member` _mouseButtons w | isReloading && SDL.ButtonRight `S.member` _mouseButtons w
= addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr = addAnyTwist $ set crDir (mouseDir + anytwist) $ theMovement cr
| otherwise = theMovement $ theTurn $ removeTwist cr | otherwise = theMovement $ theTurn $ removeTwist cr
where where
twistamount = 1.6 twistamount = 1.6
removeTwist cr' = case _crTwist cr' of removeTwist cr' = cr'
t -> cr' & crDir +~ t & crTwist .~ 0 & crDir +~ _crTwist cr'
anytwist = case cr ^? crInv . ix (_crInvSel (_creatures w IM.! i)) . itUse . useAim . aimStance of & crTwist .~ 0
Just TwoHandTwist -> twistamount * pi anytwist = case cr ^? crInv . ix (_crInvSel cr) . itUse . useAim . aimStance of
_ -> 0 Just TwoHandTwist -> twistamount * pi
addAnyTwist cr' _ -> 0
= case cr' ^? crInv . ix (_crInvSel (_creatures w IM.! i)) . itUse . useAim . aimStance of addAnyTwist = crTwist .~ anytwist
Just TwoHandTwist -> cr' & crTwist .~ twistamount * pi
_ -> cr'
theMovement theMovement
| movDir == V2 0 0 = id | movDir == V2 0 0 = id
| otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir | otherwise = crMvAbsolute (speed *.* movAbs) . set crMvDir dir
@@ -64,8 +49,7 @@ wasdWithAiming w speed i cr
movAbs = rotateV (_cameraRot w) $ normalizeV movDir movAbs = rotateV (_cameraRot w) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming isAiming = _posture (_crStance cr) == Aiming
isReloading = _posture (_crStance cr) == Reloading isReloading = _posture (_crStance cr) == Reloading
mouseDir = case w ^? creatures . ix i . crInv . ix (_crInvSel (_creatures w IM.! i)) mouseDir = case cr ^? crInv . ix (_crInvSel cr) . itScope . scopePos of
. itScope . scopePos of
Just p -> normalizeAngle $ argV Just p -> normalizeAngle $ argV
$ p +.+ 2 / _cameraZoom w $ p +.+ 2 / _cameraZoom w
*.* rotateV (_cameraRot w) (_mousePos w) *.* rotateV (_cameraRot w) (_mousePos w)
@@ -77,10 +61,10 @@ wasdM scancode = case scancode of
SDL.ScancodeS -> V2 0 (-1) SDL.ScancodeS -> V2 0 (-1)
SDL.ScancodeD -> V2 1 0 SDL.ScancodeD -> V2 1 0
SDL.ScancodeA -> V2 (-1) 0 SDL.ScancodeA -> V2 (-1) 0
_ -> V2 0 0 _ -> V2 0 0
wasdDir :: World -> Point2 wasdDir :: World -> Point2
wasdDir w = foldr ((+.+) . wasdM) (V2 0 0) $ _keys w wasdDir = foldr ((+.+) . wasdM) (V2 0 0) . _keys
{- | Set posture according to mouse presses. -} {- | Set posture according to mouse presses. -}
mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature mouseActionsCr :: S.Set SDL.MouseButton -> Creature -> Creature
+22 -23
View File
@@ -13,39 +13,38 @@ import Control.Lens
updateUsingInput :: World -> World updateUsingInput :: World -> World
updateUsingInput w = case _hudElement $ _hud w of updateUsingInput w = case _hudElement $ _hud w of
DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w
DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w
updatePressedButtons :: S.Set MouseButton -> World -> World updatePressedButtons :: S.Set MouseButton -> World -> World
updatePressedButtons pkeys w updatePressedButtons pkeys w
| lbPressed && rbPressed && inTopInv = useItem (you w) w | isDown ButtonLeft && isDown ButtonRight && inTopInv
| lbPressed && = useItem (you w) w
(inTopInv || _timeFlow w == RewindingLastFrame) | isDown ButtonLeft && (inTopInv || _timeFlow w == RewindingLastFrame)
= useLeftItem (_yourID w) w = useLeftItem (_yourID w) w
| mbPressed = w & clickMousePos .~ _mousePos w | isDown ButtonMiddle
& cameraRot -~ rotation = w & cameraRot -~ rotation
& clickMousePos .~ _mousePos w
| otherwise = w | otherwise = w
where where
inTopInv = case _hudElement (_hud w) of inTopInv = case _hudElement (_hud w) of
DisplayInventory NoSubInventory -> True DisplayInventory NoSubInventory -> True
_ -> False _ -> False
lbPressed = ButtonLeft `S.member` pkeys isDown but = but `S.member` pkeys
rbPressed = ButtonRight `S.member` pkeys rotation = angleBetween (_mousePos w) (_clickMousePos w)
mbPressed = ButtonMiddle `S.member` pkeys
rotation = angleBetween (_mousePos w) (_clickMousePos w)
updatePressedButtonsCarte :: S.Set MouseButton -> World -> World updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
updatePressedButtonsCarte pkeys w updatePressedButtonsCarte pkeys w
| rbPressed = w & clickMousePos .~ _mousePos w | isDown ButtonRight = w
& hud . carteCenter %~ (-.- trans) & clickMousePos .~ _mousePos w
| lbPressed = w & clickMousePos .~ _mousePos w & hud . carteCenter %~ (-.- trans)
& hud . carteRot -~ rot | isDown ButtonLeft = w
& hud . carteZoom *~ czoom & clickMousePos .~ _mousePos w
& hud . carteRot -~ rot
& hud . carteZoom *~ czoom
| otherwise = w | otherwise = w
where where
lbPressed = ButtonLeft `S.member` pkeys isDown but = but `S.member` pkeys
rbPressed = ButtonRight `S.member` pkeys rot = angleBetween (_mousePos w) (_clickMousePos w)
--mbPressed = ButtonMiddle `S.member` pkeys czoom = magV (_mousePos w) / magV (_clickMousePos w)
rot = angleBetween (_mousePos w) (_clickMousePos w) trans = rotateV (_carteRot (_hud w)) $ 1 / _carteZoom (_hud w) *.* (_mousePos w -.- _clickMousePos w)
czoom = magV (_mousePos w) / magV (_clickMousePos w)
trans = rotateV (_carteRot (_hud w)) $ (1 / _carteZoom (_hud w)) *.* (_mousePos w -.- _clickMousePos w)