296 lines
12 KiB
Haskell
296 lines
12 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
--{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
module Dodge.Projectile.Update (updateProjectile) where
|
|
|
|
import Dodge.Data.Object
|
|
import Control.Monad
|
|
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
|
|
import Linear.Metric
|
|
|
|
updateProjectile :: Projectile -> World -> World
|
|
updateProjectile pj w =
|
|
(cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer -~ 1)
|
|
. shellExplosionCheck pj
|
|
. moveProjectile pj
|
|
. tryThrust pj
|
|
. trySpin pj
|
|
$ doGravityPU pj w
|
|
|
|
doGravityPU :: Projectile -> World -> World
|
|
doGravityPU pj
|
|
| Grenade GBounce{} <- pj ^. pjType = applyGravityPU pj
|
|
| Grenade GStick <- pj ^. pjType = applyGravityPU pj
|
|
| otherwise = id
|
|
|
|
applyGravityPU :: Projectile -> World -> World
|
|
applyGravityPU pj w
|
|
| _pjZ pj < 1 && abs (norm $ _pjVel pj `v2z` _pjZVel pj) < 1 = w
|
|
& topj . pjVel .~ 0
|
|
| otherwise =
|
|
w & topj . pjZ .~ newz
|
|
& topj . pjZVel -~ 0.5
|
|
where
|
|
topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
|
|
newz = pj ^. pjZ + pj ^. pjZVel
|
|
|
|
-- consider pushing any hit creature back
|
|
shellExplosionCheck :: Projectile -> World -> World
|
|
shellExplosionCheck pj w
|
|
| RetiredProjectile <- pj ^. pjType
|
|
, time <= 0 =
|
|
destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
|
|
| time <= 0 = explodeShell pj w
|
|
| RetiredProjectile <- pj ^. pjType = w
|
|
| otherwise = w
|
|
where
|
|
time = _pjTimer pj
|
|
|
|
shellHitWall :: Point3 -> Point3 -> Wall -> Projectile -> World -> World
|
|
shellHitWall p' n wl pj w
|
|
| Just GStick <- pj ^? pjType . gnHitEffect =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
|
|
.~ Grenade (GStuckWall (wl ^. wlStructure))
|
|
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
|
|
| Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
|
|
, abs (dotV (pj ^. pjVel) (vNormal hitline)) < x =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
|
|
%~ reflectIn hitline
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
|
|
.~ p - normalizeV (pj ^. pjVel)
|
|
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
|
|
| otherwise = w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjTimer .~ 0
|
|
where
|
|
p = xyV3 p'
|
|
hitline = normalizeV $ uncurry (-) $ _wlLine wl
|
|
|
|
shellHitCreature :: Point3 -> Point3 -> Creature -> Projectile -> World -> World
|
|
shellHitCreature p' n cr pj w
|
|
| Just GStick <- pj ^? pjType . gnHitEffect =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
|
|
.~ Grenade
|
|
( GStuckCreature
|
|
(cr ^. crID)
|
|
(rotate3z (- cr ^. crDir) (p' - ((cr ^. crPos)`v2z`0)))
|
|
(pj ^. pjDir - cr ^. crDir)
|
|
)
|
|
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
|
|
| otherwise = w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjTimer .~ 0
|
|
where
|
|
p = xyV3 p'
|
|
|
|
shellHitFloor :: Point3 -> Point3 -> Projectile -> World -> World
|
|
shellHitFloor p' n pj w
|
|
| z < 1 && abs (norm $ _pjVel pj `v2z` zvel) < 1 = w
|
|
| otherwise =
|
|
w & topj . pjZ .~ 0.1
|
|
& topj . pjZVel %~ bouncez
|
|
& topj . pjVel %~ decvel
|
|
& topj . pjSpin %~ decspin
|
|
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
|
|
where
|
|
bouncez x
|
|
| x < -1 = -0.5 * x
|
|
| otherwise = 0
|
|
topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
|
|
zvel = pj ^. pjZVel
|
|
z = pj ^. pjZ + zvel
|
|
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
|
|
|
|
---- note this doesn't take into account moving walls, which may break the
|
|
---- bouncing in some way
|
|
tryShellBounce :: Point3 -> (Point3, Object ) -> Projectile -> World -> World
|
|
tryShellBounce p' (n, OWall wl) pj w
|
|
| Just GStick <- pj ^? pjType . gnHitEffect =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
|
|
.~ Grenade (GStuckWall (wl ^. wlStructure))
|
|
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
|
|
| Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
|
|
, abs (dotV (pj ^. pjVel) (vNormal hitline)) < x =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
|
|
%~ reflectIn hitline
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
|
|
.~ p - normalizeV (pj ^. pjVel)
|
|
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
|
|
where
|
|
p = xyV3 p'
|
|
hitline = normalizeV $ uncurry (-) $ _wlLine wl
|
|
tryShellBounce p' (n,OCreature cr) pj w
|
|
| Just GStick <- pj ^? pjType . gnHitEffect =
|
|
w
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
|
|
.~ Grenade
|
|
( GStuckCreature
|
|
(cr ^. crID)
|
|
(rotate3z (- cr ^. crDir) (p' - ((cr ^. crPos)`v2z`0)))
|
|
(pj ^. pjDir - cr ^. crDir)
|
|
)
|
|
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
|
|
where
|
|
p = xyV3 p'
|
|
tryShellBounce _ _ pj w = w
|
|
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
|
|
|
|
trySpin :: Projectile -> World -> World
|
|
trySpin pj = fromMaybe id $ do
|
|
guard (pj ^. pjTimer == 335)
|
|
(cid, s) <- pj ^? pjBarrelSpin . _Just
|
|
return $ doBarrelSpin cid s pj
|
|
|
|
tryThrust :: Projectile -> World -> World
|
|
tryThrust pj = fromMaybe id $ do
|
|
Rocket y x <- pj ^? pjType
|
|
guard $ pj ^. pjTimer <= 330 && pj ^. pjTimer >= 0
|
|
return $ doThrust pj x . pjRemoteSetDirection (Just y) pj
|
|
|
|
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 +.+ rotateV (pi + sparkD) accel) 3 10
|
|
& makeCloudAt
|
|
RocketSmoke
|
|
lifetime
|
|
(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
|
|
|
|
-- there doesn't seem to be a more sensible way to filter the first occurence of
|
|
-- a list than deleteBy
|
|
doBarrelSpin :: Int -> Float -> Projectile -> World -> World
|
|
doBarrelSpin cid i pj w =
|
|
w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin
|
|
& cWorld . lWorld . projectiles . ix pjid . pjBarrelSpin .~ Nothing
|
|
where
|
|
-- & cWorld . lWorld . projectiles . ix pjid . pjUpdates %~ deleteBy f (StartSpinPU 0 0 0)
|
|
|
|
-- f _ StartSpinPU{} = True
|
|
-- f _ _ = False
|
|
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 - 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)
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjSpin
|
|
.~ 0.5 * diffAngles ((w ^. wCam . camRot) + argV (w ^. input . mousePos)) (_pjDir pj)
|
|
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
|
|
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjSpin
|
|
.~ 0.5 * diffAngles (turnTo 0.2 (_pjPos pj) tp (_pjDir pj)) (_pjDir pj)
|
|
_ -> w
|
|
where
|
|
lw = w ^. cWorld . lWorld
|
|
|
|
moveStuckGrenade :: Creature -> Point3 -> Float -> Projectile -> World -> World
|
|
moveStuckGrenade cr p d pj w = w
|
|
|
|
moveProjectile :: Projectile -> World -> World
|
|
moveProjectile pj w
|
|
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
|
|
| Just (GStuckCreature crid poff d) <- pj ^? pjType . gnHitEffect
|
|
, Just cr <- w ^? cWorld . lWorld . creatures . ix crid =
|
|
let cpos = cr ^. crPos
|
|
cdir = cr ^. crDir
|
|
vel = cpos - cr ^. crOldPos
|
|
in w
|
|
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
|
|
.~ xyV3 ((cpos `v2z` 0) + rotate3z cdir poff)
|
|
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir .~ d + cdir
|
|
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel .~ vel
|
|
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect =
|
|
w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick
|
|
| (p,Just (n,OWall wl)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w
|
|
= shellHitWall p n wl pj w
|
|
| (p,Just (n,OFloor)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w
|
|
= shellHitFloor p n pj w
|
|
| (p,Just (n,OCreature cr)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w
|
|
= shellHitCreature p n cr pj w
|
|
| 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
|
|
where
|
|
p = _pjPos pj
|
|
|
|
explodeShell :: Projectile -> World -> World
|
|
explodeShell pj w =
|
|
w
|
|
& 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
|