This commit is contained in:
2024-09-27 23:10:01 +01:00
parent 6c3d0d5def
commit d1690ed3ac
10 changed files with 124 additions and 194 deletions
+51 -85
View File
@@ -3,80 +3,62 @@ module Dodge.Projectile.Update
( updateProjectile
) where
import Dodge.Payload
import Control.Lens
import Data.Maybe
import Dodge.Base
import Dodge.Data.World
import Dodge.EnergyBall
import Dodge.Item.Location
import Dodge.Item.Weapon.Launcher
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import Geometry
import qualified IntMapHelp as IM
import RandomHelp
import Data.Foldable
updateProjectile :: Projectile -> World -> World
updateProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
--updateProjectile pj = case pj of
-- Shell{} -> upsProjectile pj
--
--upsProjectile :: Projectile -> World -> World
--upsProjectile pj w' = foldr (`upProjectile` pj) w' (_prjUpdates pj)
updateProjectile pj w = foldl' (\w' pu -> upProjectile pu pj w') w (_prjUpdates pj)
upProjectile :: ProjectileUpdate -> Projectile -> World -> World
upProjectile pu pj = case pu of
CollisionEffectPU mscreenid -> shellCollisionEffect mscreenid pj
TimePU -> decTimMvVel pj
ThrustPU st et
| act st et -> doThrust pj
| otherwise -> id
StartSpinPU t cid spinamount
| time == t -> trySpinByCID cid spinamount pj
| otherwise -> id
RemoteDirectionPU st et mscreenid
| act st et -> pjRemoteSetDirection mscreenid pj
| otherwise -> id
ReduceSpinPU x -> reduceSpinBy x (_prjID pj)
DestroyPU mitid 0 -> destroyProjectile mitid (_prjID 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
where
time = _prjTimer pj
act st et = time <= st && time >= et
shellCollisionEffect :: Maybe Int -> Projectile -> World -> World
shellCollisionEffect mscreenid = shellCollisionCheck
$ \pj -> explodeShell mscreenid (_prjID pj)
shellCollisionCheck :: (Projectile -> World -> World) -> Projectile -> World -> World
shellCollisionCheck doExplode pj w
| time > 330 && circOnSomeWall oldPos 4 w = doExplode pj w
| time <= 330 && anythingHitCirc 2 oldPos newPos w = doExplode pj w
| time <= 0 = doExplode pj w
shellCollisionCheck f pj w
| time > 330 && circOnSomeWall oldPos 4 w = f pj w
| time <= 330 && anythingHitCirc 2 oldPos newPos w = f pj w
| time <= 0 = f pj w
| otherwise = w
where
time = _prjTimer pj
oldPos = _prjPos pj
vel = _prjVel pj
newPos = oldPos +.+ vel
newPos = oldPos +.+ _prjVel pj
remoteShellCollisionCheck :: Maybe Int -> Projectile -> World -> World
remoteShellCollisionCheck mscreenid = shellCollisionCheck
$ \pj -> explodeRemoteRocket mscreenid (_prjID pj)
--plainShellCollisionCheck :: Proj -> World -> World
--plainShellCollisionCheck = shellCollisionCheck $ \pj ->
-- usePayload (_prjPayload pj) (_prjPos pj)
-- . stopSoundFrom (ShellSound (_prjID pj))
-- . (cWorld . lWorld . projectiles %~ IM.delete (_prjID pj))
upProjectile :: ProjectileUpdate -> Projectile -> World -> World
upProjectile pu pj = case pu of
PJRemoteShellCollisionCheck mscreenid -> remoteShellCollisionCheck mscreenid pj
-- PJShellCollisionCheck -> plainShellCollisionCheck pj
PJDecTimMvVel -> decTimMvVel pj
PJThrust st et
| act st et -> doThrust pj
| otherwise -> id
PJSpin t cid spinamount
| ain t -> trySpinByCID cid spinamount pj
| otherwise -> id
PJRemoteSetDirection st et mscreenid
| act st et -> pjRemoteSetDirection mscreenid pj
| otherwise -> id
PJReduceSpin x -> reduceSpinBy x pj
-- PJRemoteDirection st et cid itid
-- | act st et -> setRemoteDir cid itid pj
-- | otherwise -> id
-- PJSetScope itid -> setRemoteScope itid (_prjPos pj)
PJRetireRemote mitid 0 pjid -> retireRemoteProj mitid pjid
-- the following requires that this is at the top of the update list, which is
-- not ideal
PJRetireRemote _ _ pjid -> cWorld . lWorld . projectiles . ix pjid . prjUpdates . ix 0 . pjuTimer -~ 1
where
time = _prjTimer pj
act st et = time <= st && time >= et
ain t = time == t
retireRemoteProj :: Maybe Int -> Int -> World -> World
retireRemoteProj mitid pjid w = w & cWorld . lWorld . projectiles %~ IM.delete pjid
destroyProjectile :: Maybe Int -> Int -> World -> World
destroyProjectile mitid pjid w = w & cWorld . lWorld . projectiles %~ IM.delete pjid
& removelink
where
removelink = fromMaybe id $ do
@@ -124,20 +106,6 @@ trySpinByCID cid i pj w = w & cWorld . lWorld . projectiles . ix pjid . prjSpin
_ -> 0
spinFactor = 5 * (6 - fromIntegral i)
--pjTrack :: Int -> Proj -> World -> World
--pjTrack crid pj w = rotateToTarget pj w
-- where
-- rotateToTarget _ = fromMaybe id $ do
-- tpos <- w ^? cWorld . lWorld . creatures . ix crid . crTargeting . ctPos . _Just
-- return $
-- cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin
-- .~ turnToAmount
-- 0.15
-- (_prjPos pj)
-- tpos
-- (argV $ _prjAcc pj)
-- --itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid
-- note this only allows YOU to remotely track projectiles
pjRemoteSetDirection :: Maybe Int -> Projectile -> World -> World
pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
@@ -150,23 +118,8 @@ pjRemoteSetDirection mscreenid pj w = fromMaybe w $ do
turntonewdir = magV (_prjAcc pj) *.* unitVectorAtAngle newdir
return $ w & cWorld . lWorld . projectiles . ix (_prjID pj) . prjAcc .~ turntonewdir
--pjTrack :: Int -> Proj -> World -> World
--pjTrack screenid pj w = w-- rotateToTarget pj w
-- where
-- rotateToTarget _ = fromMaybe id $ do
-- tpos <- w ^? cWorld . lWorld . creatures . ix crid . crTargeting . ctPos . _Just
-- return $
-- cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin
-- .~ turnToAmount
-- 0.15
-- (_prjPos pj)
-- tpos
-- (argV $ _prjAcc pj)
-- --itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid
reduceSpinBy :: Float -> Projectile -> World -> World
reduceSpinBy x pj = cWorld . lWorld . projectiles . ix (_prjID pj) . prjSpin *~ x
reduceSpinBy :: Float -> Int -> World -> World
reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . prjSpin *~ x
decTimMvVel :: Projectile -> World -> World
decTimMvVel pj =
@@ -179,3 +132,16 @@ decTimMvVel pj =
rot = _prjSpin pj
vel = _prjVel pj
pjid = _prjID pj
explodeShell :: Maybe Int -> Int -> World -> World
explodeShell mitid pjid w =
w
& cWorld . lWorld . projectiles . ix pjid . prjUpdates .~ [DestroyPU mitid 30]
& cWorld . lWorld . projectiles . ix pjid . prjDraw .~ DrawBlankProjectile
-- & itPoint . itUse . heldUse .~ HeldDoNothing
-- & itPoint . itUse . heldMods .~ DoNothingMod
& usePayload (_prjPayload thepj) (_prjPos thepj)
& stopSoundFrom (ShellSound pjid)
where
-- itPoint = pointerToItemLocation $ w ^?! cWorld . lWorld . itemLocations . ix itid-- _itemLocations (_cWorld w) IM.! itid
thepj = w ^?! cWorld . lWorld . projectiles . ix pjid