This commit is contained in:
2024-12-28 10:31:58 +00:00
parent 39a76f758a
commit e028c54948
10 changed files with 91 additions and 102 deletions
+47 -51
View File
@@ -22,10 +22,10 @@ import NewInt
import RandomHelp
updateProjectile :: Projectile -> World -> World
updateProjectile pj w = foldl' (\w' pu -> upProjectile pu pj w') w (_prjUpdates pj)
updateProjectile pj w = foldl' (flip $ upProjectile pj) w (_pjUpdates pj)
upProjectile :: ProjectileUpdate -> Projectile -> World -> World
upProjectile pu pj = case pu of
upProjectile :: Projectile -> ProjectileUpdate -> World -> World
upProjectile pj pu = case pu of
CollisionEffectPU mdetonatorid mscreenid ->
shellCollisionCheck
mdetonatorid
@@ -33,51 +33,51 @@ upProjectile pu pj = case pu of
pj
TimePU -> decTimMvVel pj
ThrustPU st et
| act st et -> doThrust pj (pj ^? prjType . rkSmoke . _Just)
| 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 ^? prjType . rkHoming) pj
| act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
| otherwise -> id
ReduceSpinPU x -> reduceSpinBy x (_prjID pj)
DestroyPU mitid 0 -> destroyProjectile mitid (_prjID pj)
ReduceSpinPU x -> reduceSpinBy x (_pjID pj)
DestroyPU mitid 0 -> destroyProjectile mitid (_pjID pj)
-- the following requires that this is at the top of the update list, which is
-- not ideal
DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_prjID pj) . prjUpdates . ix 0 . pjuTimer -~ 1
DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates . ix 0 . pjuTimer -~ 1
ApplyGravityPU -> applyGravityPU pj
where
time = _prjTimer pj
time = _pjTimer pj
act st et = time <= st && time >= et
applyGravityPU :: Projectile -> World -> World
applyGravityPU pj w
| newz <= 0 && abs (pj ^. prjZVel) < 1 =
| newz <= 0 && abs (pj ^. pjZVel) < 1 =
w
& topj . prjVel %~ decvel
& topj . prjSpin %~ decspin
& topj . pjVel %~ decvel
& topj . pjSpin %~ decspin
| newz < 0 =
w & topj . prjZ .~ 0
& topj . prjZVel %~ bouncez
& topj . prjVel %~ decvel
& topj . prjSpin %~ decspin
& soundStart (ShellSound (pj ^. prjID)) (pj ^. prjPos) click1S Nothing
w & topj . pjZ .~ 0
& topj . pjZVel %~ bouncez
& topj . pjVel %~ decvel
& topj . pjSpin %~ decspin
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
| otherwise =
w & topj . prjZ .~ newz
& topj . prjZVel -~ 0.5
w & topj . pjZ .~ newz
& topj . pjZVel -~ 0.5
where
topj = cWorld . lWorld . projectiles . ix (pj ^. prjID)
topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
bouncez z
| z < -1 = -0.5 * z
| otherwise = 0
decvel v
| magV v > 1 = rotateV (5 * pj ^. prjSpin) $ 0.8 * 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 ^. prjZ + pj ^. prjZVel
newz = pj ^. pjZ + pj ^. pjZVel
--shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
shellCollisionCheck ::
@@ -87,14 +87,13 @@ shellCollisionCheck ::
World ->
World
shellCollisionCheck detid screenid pj w
| anythingHitCirc 2 oldPos newPos w = g
| anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g
| time <= 0 = g
| otherwise = w
where
g = explodeShell detid screenid pj w
time = _prjTimer pj
oldPos = _prjPos pj
newPos = oldPos +.+ _prjVel pj
time = _pjTimer pj
oldPos = _pjPos pj
destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
destroyProjectile mitid pjid w =
@@ -112,10 +111,10 @@ doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
doThrust pj smoke w =
w
& randGen .~ g
& cWorld . lWorld . projectiles . ix i . prjVel %~ (\v -> accel +.+ frict *.* v)
& 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 +.+ rotateV (pi + sparkD) accel) 3 10
& makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
& shellTrailCloud
lifetime
trailfadetime
@@ -126,10 +125,10 @@ doThrust pj smoke w =
| smoke == Just ReducedRocketSmoke = (50, 200)
| otherwise = (300, 500)
trailfadetime = fst . randomR (100, 300) $ _randGen w
accel = rotateV (pj ^. prjDir) (V2 3 0)
i = _prjID pj
oldPos = _prjPos pj
vel = _prjVel pj
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
@@ -143,10 +142,10 @@ trySpinByCID ::
Projectile ->
World ->
World
trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin .~ newSpin
trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin
where
pjid = _prjID pj
dir = argV $ _prjVel pj
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
@@ -158,30 +157,29 @@ 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 (_prjID pj) . prjDir
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 (_prjID pj) . prjDir
%~ turnTo 0.2 (_prjPos pj) tp
w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
%~ turnTo 0.2 (_pjPos pj) tp
_ -> w
where
lw = w ^. cWorld . lWorld
reduceSpinBy :: Float -> Int -> World -> World
reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . prjSpin *~ x
reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . pjSpin *~ x
decTimMvVel :: Projectile -> World -> World
decTimMvVel pj =
cWorld . lWorld . projectiles . ix pjid
%~ ( (prjTimer -~ 1)
. (prjPos %~ (+.+ vel))
. (prjDir +~ rot)
cWorld . lWorld . projectiles . ix (_pjID pj)
%~ ( (pjTimer -~ 1)
. (pjPos %~ (+.+ vel))
. (pjDir +~ rot)
)
where
rot = _prjSpin pj
vel = _prjVel pj
pjid = _prjID pj
rot = _pjSpin pj
vel = _pjVel pj
explodeShell ::
Maybe (NewInt ItmInt) ->
@@ -191,14 +189,12 @@ explodeShell ::
World
explodeShell mdetid screenid pj w =
w
& cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU screenid 30]
& usePayload (_prjPayload pj) (_prjPos pj) (_prjVel pj)
& cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ [DestroyPU screenid 30]
& usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj)
& stopSoundFrom (ShellSound pjid)
& updatedetonator
where
updatedetonator = fromMaybe id $ do
detid <- mdetid
return $ pointerToItemID detid . itUse . uaParams . apProjectiles %~ delete pjid
deleteif (Just x) | x == pjid = Nothing
deleteif x = x
pjid = pj ^. prjID
pjid = pj ^. pjID