Continue projectile udpate refactor

This commit is contained in:
2024-12-28 21:58:45 +00:00
parent 2fdc6ae557
commit 30be7b0983
4 changed files with 22 additions and 22 deletions
+3 -7
View File
@@ -22,13 +22,9 @@ data ProjectileUpdate
| StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int} | StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
| RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int} | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
| ReduceSpinPU {_pjuReduceSpin :: Float} | ReduceSpinPU {_pjuReduceSpin :: Float}
| DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt) -- | DestroyPU {_pjuScreenID :: Maybe (NewInt ItmInt)
,_pjuTimer :: Int} -- ,_pjuTimer :: Int}
| TimePU -- | TimePU
| CollisionEffectPU
-- {_pjuDetonatorID :: Maybe (NewInt ItmInt)
-- ,_pjuScreenID :: Maybe (NewInt ItmInt)
-- }
| ApplyGravityPU | ApplyGravityPU
deriving (Show, Eq, Ord, Read) --Generic, Flat) deriving (Show, Eq, Ord, Read) --Generic, Flat)
+2 -3
View File
@@ -32,9 +32,8 @@ createShell mdetonator mscreen pjtype payload muz cr w = w
, _pjPayload = payload , _pjPayload = payload
, _pjTimer = lifespan , _pjTimer = lifespan
, _pjUpdates = , _pjUpdates =
[ CollisionEffectPU [-- TimePU
, TimePU StartSpinPU (lifespan - 15) (_crID cr) spinamount
, StartSpinPU (lifespan - 15) (_crID cr) spinamount
, RemoteDirectionPU (lifespan - thrustdelay) 0 , RemoteDirectionPU (lifespan - thrustdelay) 0
, ReduceSpinPU (1 - spindrag * 2 / 200) , ReduceSpinPU (1 - spindrag * 2 / 200)
] <> thrustorgrav ] <> thrustorgrav
+1 -2
View File
@@ -4,7 +4,6 @@ module Dodge.Projectile.Draw (
import Control.Lens import Control.Lens
import Data.Strict.Tuple import Data.Strict.Tuple
import Dodge.Data.Item.Use.Consumption.Ammo
import Dodge.Data.Projectile import Dodge.Data.Projectile
import Geometry import Geometry
import Picture import Picture
@@ -13,7 +12,7 @@ import ShapePicture
drawProjectile :: Projectile -> SPic drawProjectile :: Projectile -> SPic
drawProjectile pj drawProjectile pj
| Just DestroyPU{} <- pj ^? pjUpdates . ix 0 = mempty | RetiredProjectile <- pj ^. pjType = mempty
| Just NoHoming <- pj ^? pjType . rkHoming = | Just NoHoming <- pj ^? pjType . rkHoming =
drawShell Nothing pj drawShell Nothing pj
| Just _ <- pj ^? pjType . rkHoming = | Just _ <- pj ^? pjType . rkHoming =
+16 -10
View File
@@ -22,16 +22,17 @@ import NewInt
import RandomHelp import RandomHelp
updateProjectile :: Projectile -> World -> World updateProjectile :: Projectile -> World -> World
updateProjectile pj w = foldl' (flip $ upProjectile pj) w (_pjUpdates pj) updateProjectile pj w =
decTimMvVel pj .
upProjectile :: Projectile -> ProjectileUpdate -> World -> World
upProjectile pj pu = case pu of
CollisionEffectPU ->
shellCollisionCheck shellCollisionCheck
(pj ^. pjDetonatorID) (pj ^. pjDetonatorID)
(pj ^. pjScreenID) (pj ^. pjScreenID)
pj pj $
TimePU -> decTimMvVel pj foldl' (flip $ upProjectile pj) w (_pjUpdates pj)
upProjectile :: Projectile -> ProjectileUpdate -> World -> World
upProjectile pj pu = case pu of
-- TimePU -> decTimMvVel pj
ThrustPU st et ThrustPU st et
| act st et -> doThrust pj (pj ^? pjType . rkSmoke . _Just) | act st et -> doThrust pj (pj ^? pjType . rkSmoke . _Just)
| otherwise -> id | otherwise -> id
@@ -42,10 +43,10 @@ upProjectile pj pu = case pu of
| act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj | act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
| otherwise -> id | otherwise -> id
ReduceSpinPU x -> reduceSpinBy x (_pjID pj) ReduceSpinPU x -> reduceSpinBy x (_pjID pj)
DestroyPU mitid 0 -> destroyProjectile mitid (_pjID pj) -- DestroyPU mitid 0 -> destroyProjectile mitid (_pjID pj)
-- the following requires that this is at the top of the update list, which is -- the following requires that this is at the top of the update list, which is
-- not ideal -- not ideal
DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates . ix 0 . pjuTimer -~ 1 -- DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates . ix 0 . pjuTimer -~ 1
ApplyGravityPU -> applyGravityPU pj ApplyGravityPU -> applyGravityPU pj
where where
time = _pjTimer pj time = _pjTimer pj
@@ -87,6 +88,10 @@ shellCollisionCheck ::
World -> World ->
World World
shellCollisionCheck detid screenid pj w shellCollisionCheck detid screenid pj w
| RetiredProjectile <- pj ^. pjType
, time <= -30
= destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
| RetiredProjectile <- pj ^. pjType = w
| anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g | anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g
| time <= 0 = g | time <= 0 = g
| otherwise = w | otherwise = w
@@ -186,7 +191,8 @@ explodeShell ::
World World
explodeShell mdetid screenid pj w = explodeShell mdetid screenid pj w =
w w
& cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ [DestroyPU screenid 30] -- & cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ [DestroyPU screenid 30]
& cWorld . lWorld . projectiles . ix pjid . pjType .~ RetiredProjectile
& usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj) & usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj)
& stopSoundFrom (ShellSound pjid) & stopSoundFrom (ShellSound pjid)
& updatedetonator & updatedetonator