238 lines
8.9 KiB
Haskell
238 lines
8.9 KiB
Haskell
--{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
module Dodge.Projectile.Update (
|
|
updateProjectile,
|
|
) where
|
|
|
|
import Data.Foldable
|
|
import Data.List (delete)
|
|
import Data.Maybe
|
|
import Dodge.Base
|
|
import Dodge.Data.World
|
|
import Dodge.EnergyBall
|
|
import Dodge.Item.Location
|
|
import Dodge.Movement.Turn
|
|
import Dodge.Payload
|
|
import Dodge.SoundLogic
|
|
import Dodge.WorldEvent.Cloud
|
|
import Dodge.WorldEvent.Sound
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import LensHelp
|
|
import NewInt
|
|
import RandomHelp
|
|
|
|
updateProjectile :: Projectile -> World -> World
|
|
updateProjectile pj w =
|
|
(cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer -~ 1)
|
|
. pjMovement pj
|
|
. shellCollisionCheck
|
|
pj
|
|
$ foldl' (flip $ upProjectile pj) w (_pjUpdates pj)
|
|
|
|
upProjectile :: Projectile -> ProjectileUpdate -> World -> World
|
|
upProjectile pj pu = case pu of
|
|
ThrustPU st et
|
|
| act st et -> doThrust pj (pj ^? pjType . rkSmoke . _Just)
|
|
| otherwise -> id
|
|
StartSpinPU t cid spinamount
|
|
| time == t -> trySpinByCID cid spinamount pj
|
|
| otherwise -> id
|
|
RemoteDirectionPU st et
|
|
| act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
|
|
| otherwise -> id
|
|
-- ReduceSpinPU x -> reduceSpinBy x (_pjID pj)
|
|
ApplyGravityPU -> applyGravityPU pj
|
|
where
|
|
time = _pjTimer pj
|
|
act st et = time <= st && time >= et
|
|
|
|
applyGravityPU :: Projectile -> World -> World
|
|
applyGravityPU pj w
|
|
| newz <= 0 && abs (pj ^. pjZVel) < 1 =
|
|
w
|
|
& topj . pjVel %~ decvel
|
|
& topj . pjSpin %~ decspin
|
|
| newz < 0 =
|
|
w & topj . pjZ .~ 0
|
|
& topj . pjZVel %~ bouncez
|
|
& topj . pjVel %~ decvel
|
|
& topj . pjSpin %~ decspin
|
|
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
|
|
| otherwise =
|
|
w & topj . pjZ .~ newz
|
|
& topj . pjZVel -~ 0.5
|
|
where
|
|
topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
|
|
bouncez z
|
|
| z < -1 = -0.5 * z
|
|
| otherwise = 0
|
|
decvel v
|
|
| magV v > 1 = rotateV (5 * pj ^. pjSpin) $ 0.8 * v
|
|
| otherwise = 0
|
|
decspin x
|
|
| abs x < 0.01 = 0
|
|
| otherwise = x * 0.9
|
|
newz = pj ^. pjZ + pj ^. pjZVel
|
|
|
|
-- consider using thingHit, pushing any hit creature back
|
|
shellCollisionCheck ::
|
|
Projectile ->
|
|
World ->
|
|
World
|
|
shellCollisionCheck pj w
|
|
| RetiredProjectile <- pj ^. pjType
|
|
, time <= 0 =
|
|
destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
|
|
| time <= 0 = g
|
|
| RetiredProjectile <- pj ^. pjType = w
|
|
| Just thit <- thingHit oldPos (oldPos + _pjVel pj) w = tryShellBounce thit pj w
|
|
-- | anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g
|
|
| otherwise = w
|
|
where
|
|
g = explodeShell pj w
|
|
time = _pjTimer pj
|
|
oldPos = _pjPos pj
|
|
|
|
-- note this doesn't take into account moving walls, which may break the
|
|
-- bouncing in some way
|
|
tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
|
|
tryShellBounce (p, Right wl) pj w
|
|
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
|
|
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
|
|
| Just GStick <- pj ^? pjType . gnHitEffect = w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
|
|
.~ Grenade (GStuckWall (wl ^. wlStructure))
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
|
|
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
|
|
| Just x <- pj ^? pjType . gnHitEffect . bounceTolerance =
|
|
if abs (dotV (pj ^. pjVel) (vNormal hitline)) < x
|
|
then w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
|
|
%~ reflectIn hitline
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
|
|
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
|
|
else explodeShell pj w
|
|
where
|
|
hitline = normalizeV $ uncurry (-) $ _wlLine wl
|
|
tryShellBounce (p, Left cr) pj w
|
|
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
|
|
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
|
|
| Just GStick <- pj ^? pjType . gnHitEffect = w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
|
|
.~ Grenade
|
|
(GStuckCreature
|
|
(cr ^. crID)
|
|
(rotateV (- cr ^. crDir) (p - cr ^. crPos))
|
|
(pj ^. pjDir - cr ^. crDir)
|
|
)
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
|
|
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
|
|
tryShellBounce _ pj w = explodeShell pj w
|
|
|
|
destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
|
|
destroyProjectile mitid pjid w =
|
|
w & cWorld . lWorld . projectiles %~ IM.delete pjid
|
|
& removelink
|
|
where
|
|
removelink = fromMaybe id $ do
|
|
itid <- fmap _unNInt mitid
|
|
loc <- w ^? cWorld . lWorld . itemLocations . ix itid
|
|
return $ pointerToItemLocation loc . itUse . uaParams . apProjectiles %~ delete pjid
|
|
|
|
doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
|
|
doThrust pj smoke w =
|
|
w
|
|
& randGen .~ g
|
|
& cWorld . lWorld . projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
|
|
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
|
|
-- & makeFlamelet (oldPos -.- vel) (vel + 2 * rotateV (pi + sparkD) accel) 3 10
|
|
& makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
|
|
& shellTrailCloud
|
|
lifetime
|
|
trailfadetime
|
|
(addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
|
|
where
|
|
lifetime = fst . randomR lt $ _randGen w
|
|
lt
|
|
| smoke == Just ReducedRocketSmoke = (50, 200)
|
|
| otherwise = (300, 500)
|
|
trailfadetime = fst . randomR (100, 300) $ _randGen w
|
|
accel = rotateV (pj ^. pjDir) (V2 3 0)
|
|
i = _pjID pj
|
|
oldPos = _pjPos pj
|
|
vel = _pjVel pj
|
|
newPos = oldPos +.+ vel
|
|
(frict, g) = randomR (0.6, 0.9) $ _randGen w
|
|
(sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
|
|
r1 = randInCirc 10 & evalState $ _randGen w
|
|
|
|
trySpinByCID ::
|
|
-- | creature id
|
|
Int ->
|
|
-- | Spin amount
|
|
Int ->
|
|
Projectile ->
|
|
World ->
|
|
World
|
|
trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin
|
|
where
|
|
pjid = _pjID pj
|
|
dir = argV $ _pjVel pj
|
|
newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
|
|
Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
|
|
_ -> 0
|
|
spinFactor = 5 * (6 - fromIntegral i)
|
|
|
|
-- note this only allows YOU to remotely track projectiles
|
|
pjRemoteSetDirection :: Maybe RocketHoming -> Projectile -> World -> World
|
|
pjRemoteSetDirection ph pj w = case ph of
|
|
Just (HomeUsingRemoteScreen screenid)
|
|
| lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
|
|
== lw ^? itemLocations . ix (_unNInt screenid) . ilInvID ->
|
|
w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
|
|
.~ (w ^. wCam . camRot) + argV (w ^. input . mousePos)
|
|
Just (HomeUsingTargeting itid)
|
|
| Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
|
|
w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
|
|
%~ turnTo 0.2 (_pjPos pj) tp
|
|
_ -> w
|
|
where
|
|
lw = w ^. cWorld . lWorld
|
|
|
|
pjMovement :: Projectile -> World -> World
|
|
pjMovement pj w
|
|
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
|
|
| Just (GStuckCreature crid p d) <- pj ^? pjType . gnHitEffect = fromMaybe w $ do
|
|
cpos <- w ^? cWorld . lWorld . creatures . ix crid . crPos
|
|
cdir <- w ^? cWorld . lWorld . creatures . ix crid . crDir
|
|
return $
|
|
w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
|
|
.~ cpos + rotateV cdir p
|
|
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
|
|
.~ d + cdir
|
|
| otherwise =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjSpin *~ 0.99
|
|
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos +~ _pjVel pj
|
|
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir +~ _pjSpin pj
|
|
|
|
explodeShell ::
|
|
Projectile ->
|
|
World ->
|
|
World
|
|
explodeShell pj w =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ []
|
|
& cWorld . lWorld . projectiles . ix pjid . pjType .~ RetiredProjectile
|
|
& cWorld . lWorld . projectiles . ix pjid . pjVel .~ 0
|
|
& cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 30
|
|
& usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj)
|
|
& stopSoundFrom (ShellSound pjid)
|
|
& updatedetonator
|
|
where
|
|
updatedetonator = fromMaybe id $ do
|
|
detid <- pj ^. pjDetonatorID
|
|
return $ pointerToItemID detid . itUse . uaParams . apProjectiles %~ delete pjid
|
|
pjid = pj ^. pjID
|