Simplify bullet movement code
This commit is contained in:
+69
-74
@@ -2,49 +2,43 @@ module Dodge.Bullet (
|
||||
updateBullet,
|
||||
) where
|
||||
|
||||
import Linear
|
||||
import Dodge.Item.Weapon.Bullet
|
||||
import System.Random
|
||||
import Data.Bifunctor
|
||||
import Data.Foldable
|
||||
import Data.Maybe
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Data.World
|
||||
import Dodge.EnergyBall
|
||||
import Dodge.Item.Weapon.Bullet
|
||||
import Dodge.Movement.Turn
|
||||
import Dodge.WorldEvent.SpawnParticle
|
||||
import Dodge.WorldEvent.ThingsHit
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
--import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
import qualified ListHelp as List
|
||||
import Data.Bifunctor
|
||||
import System.Random
|
||||
|
||||
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
|
||||
updateBullet w bu
|
||||
| magV (_buVel bu) < 1 = (endspawn w, Nothing)
|
||||
-- have to be slightly carefull not to accelerate bullets using magnets
|
||||
| magV (_buVel bu) < 1 = (useBulletPayload bu (_buPos bu) w, Nothing)
|
||||
-- have to be slightly carefull not to accelerate bullets using magnets
|
||||
| otherwise = second (Just . updateBulVel) . hitEffFromBul w $ applyMagnetsToBul bu w
|
||||
where
|
||||
endspawn = fromMaybe id $ do
|
||||
partspawn <- useBulletPayload bu
|
||||
return $ partspawn p
|
||||
p = _buPos bu
|
||||
|
||||
-- do we want this to drain energy from the deflection source?
|
||||
applyMagnetsToBul :: Bullet -> World -> Bullet
|
||||
applyMagnetsToBul bu = foldl' doMagnetBuBu bu . _oldMagnets . _lWorld . _cWorld
|
||||
|
||||
doMagnetBuBu :: Bullet -> Magnet -> Bullet
|
||||
doMagnetBuBu bu mg
|
||||
doMagnetBuBu bu mg
|
||||
| notclose = bu
|
||||
| otherwise = case _mgField mg of
|
||||
MagnetAlign -> doturntowards mgalignpos
|
||||
MagnetDeflect -> doturntowards mgdeflectpos
|
||||
MagnetAttract -> doturntowards mpos
|
||||
MagnetRepulse -> doturntowards (2*bpos - mpos)
|
||||
MagnetRepulse -> doturntowards (2 * bpos - mpos)
|
||||
where
|
||||
notclose = d > 100
|
||||
doturntowards p = bu & buVel %~ vecTurnTo (10 * pi / (d+40)) bpos p
|
||||
doturntowards p = bu & buVel %~ vecTurnTo (10 * pi / (d + 40)) bpos p
|
||||
bvel = bu ^. buVel
|
||||
mpos = mg ^. mgPos
|
||||
bpos = bu ^. buPos
|
||||
@@ -58,9 +52,10 @@ doMagnetBuBu bu mg
|
||||
|
||||
updateBulVel :: Bullet -> Bullet
|
||||
updateBulVel bt = bt & buVel .*.*~ _buDrag bt
|
||||
|
||||
--case _buTrajectory bt of
|
||||
-- BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag bt
|
||||
-- MagnetTrajectory tpos -> bt
|
||||
-- MagnetTrajectory tpos -> bt
|
||||
-- & buVel %~ (clipV 20 . (+.+ 5 *.* normalizeV (tpos -.- _buPos bt)))
|
||||
-- FlechetteTrajectory tpos -> bt & buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
|
||||
-- BezierTrajectory spos tpos xpos ->
|
||||
@@ -76,8 +71,8 @@ updateBulVel bt = bt & buVel .*.*~ _buDrag bt
|
||||
-- leftitms <- itm ^? ldtLeft
|
||||
-- mag <- lookup (AmmoInLink 0 atype) leftitms
|
||||
-- thebullet <- mag ^? ldtValue . itUse . amagParams . ampBullet
|
||||
-- return $ w
|
||||
-- & randGen .~ g'
|
||||
-- return $ w
|
||||
-- & randGen .~ g'
|
||||
-- & cWorld . lWorld . instantBullets
|
||||
-- .:~ ( thebullet
|
||||
-- & buPos .~ _crPos cr
|
||||
@@ -113,16 +108,16 @@ bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
|
||||
bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
|
||||
bounceDir _ = Nothing
|
||||
|
||||
useBulletPayload :: Bullet -> Maybe (Point2 -> World -> World)
|
||||
useBulletPayload :: Bullet -> Point2 -> World -> World
|
||||
useBulletPayload bu = case _buPayload bu of
|
||||
BulSpark -> Nothing
|
||||
BulFlak -> Just (makeFlak bu)
|
||||
BulFrag -> Just makeFragBullets
|
||||
BulGas -> Just (`makeGasCloud` V2 0 0)
|
||||
BulBall IncBall -> Just incBallAt
|
||||
BulBall ConcBall -> Just $ \p -> cWorld . lWorld . shockwaves .:~ concBall p
|
||||
BulBall TeslaBall -> Just makeStaticBall
|
||||
BulBall FlashBall -> Just makeFlashBall
|
||||
BulSpark -> const id
|
||||
BulFlak -> makeFlak bu
|
||||
BulFrag -> makeFragBullets
|
||||
BulGas -> (`makeGasCloud` V2 0 0)
|
||||
BulBall IncBall -> incBallAt
|
||||
BulBall ConcBall -> \p -> cWorld . lWorld . shockwaves .:~ concBall p
|
||||
BulBall TeslaBall -> makeStaticBall
|
||||
BulBall FlashBall -> makeFlashBall
|
||||
|
||||
makeFragBullets :: Point2 -> World -> World
|
||||
makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus
|
||||
@@ -130,44 +125,50 @@ makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus
|
||||
bus = zipWith f (take 10 as) (take 10 ss)
|
||||
as = randomRs (0, 2 * pi) $ _randGen w
|
||||
ss = randomRs (5, 15) $ _randGen w
|
||||
f a s = defaultBullet & buVel .~ s *.* unitVectorAtAngle a
|
||||
& buDrag .~ 0.8
|
||||
& buPos .~ p
|
||||
& buOldPos .~ p
|
||||
& buWidth .~ 1
|
||||
& buDamages .~
|
||||
[ Damage PIERCING 5 0 0 0 $ PushBackDamage 2
|
||||
]
|
||||
f a s =
|
||||
defaultBullet & buVel .~ s *.* unitVectorAtAngle a
|
||||
& buDrag .~ 0.8
|
||||
& buPos .~ p
|
||||
& buOldPos .~ p
|
||||
& buWidth .~ 1
|
||||
& buDamages .~ [Damage PIERCING 5 0 0 0 $ PushBackDamage 2]
|
||||
|
||||
makeFlak :: Bullet -> Point2 -> World -> World
|
||||
makeFlak bu _ w = w & cWorld . lWorld . bullets .++~ [f x | x <- xs]
|
||||
where
|
||||
s = min 10 (0.5 * magV (_buVel bu))
|
||||
xs = take 5 $ randomRs (-s,s) $ _randGen w
|
||||
f x = bu & buVel %~ g x
|
||||
-- & buTimer .~ 97
|
||||
& buPayload .~ BulSpark
|
||||
& buWidth .~ 0.5
|
||||
& buDamages .~
|
||||
[ Damage PIERCING 25 0 0 0 $ PushBackDamage 2
|
||||
]
|
||||
xs = take 5 $ randomRs (- s, s) $ _randGen w
|
||||
f x =
|
||||
bu & buVel %~ g x
|
||||
-- & buTimer .~ 97
|
||||
& buPayload .~ BulSpark
|
||||
& buWidth .~ 0.5
|
||||
& buDamages
|
||||
.~ [Damage PIERCING 25 0 0 0 $ PushBackDamage 2]
|
||||
g x v = v +.+ x *.* normalizeV (vNormal v)
|
||||
|
||||
hitEffFromBul :: World -> Bullet -> (World, Bullet)
|
||||
hitEffFromBul w bu = case _buEffect bu of
|
||||
PenetrateBullet -> movePenBullet bu hitstream w
|
||||
BounceBullet -> case List.safeHead hitstream of
|
||||
Nothing -> (w, moveBullet bu)
|
||||
Just (hp, crwl) -> fromMaybe (expireAndDamage bu hitstream w) $ do
|
||||
dir <- bounceDir (hp, crwl)
|
||||
return
|
||||
( w
|
||||
, bu
|
||||
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
|
||||
& buVel %~ reflectIn dir
|
||||
-- & buTrajectory .~ BasicBulletTrajectory
|
||||
-- & buTimer -~ 1
|
||||
)
|
||||
BounceBullet -> fromMaybe (expireAndDamage bu hitstream w) $ do
|
||||
(hp, crwl) <- hitstream ^? _head
|
||||
dir <- bounceDir (hp, crwl)
|
||||
return
|
||||
( w
|
||||
, bu
|
||||
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
|
||||
& buVel %~ reflectIn dir
|
||||
)
|
||||
-- BounceBullet -> case List.safeHead hitstream of
|
||||
-- Nothing -> (w, moveBullet bu)
|
||||
-- Just (hp, crwl) -> fromMaybe (expireAndDamage bu hitstream w) $ do
|
||||
-- dir <- bounceDir (hp, crwl)
|
||||
-- return
|
||||
-- ( w
|
||||
-- , bu
|
||||
-- & buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
|
||||
-- & buVel %~ reflectIn dir
|
||||
-- )
|
||||
DestroyBullet -> expireAndDamage bu hitstream w
|
||||
where
|
||||
ep = sp +.+ _buVel bu
|
||||
@@ -182,7 +183,9 @@ setFromToDams bu p = map f (_buDamages bu)
|
||||
damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
|
||||
damageThingHit bu (p, crwl) = case crwl of
|
||||
Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
||||
Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
||||
-- Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
||||
-- hopefully the following doesn't introduce a space leak
|
||||
Right wl -> cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty <>~ dams
|
||||
where
|
||||
dams = setFromToDams bu p
|
||||
|
||||
@@ -196,29 +199,21 @@ expireAndDamage bt things w = case List.safeHead things of
|
||||
Just x -> (damageThingHit bt x w, stopBulletAt (fst x) bt)
|
||||
|
||||
moveBullet :: Bullet -> Bullet
|
||||
moveBullet pt = pt
|
||||
& buPos %~ (+.+ _buVel pt)
|
||||
& buOldPos .~ _buPos pt
|
||||
moveBullet pt = pt & buPos +~ _buVel pt & buOldPos .~ _buPos pt
|
||||
|
||||
stopBulletAt :: Point2 -> Bullet -> Bullet
|
||||
stopBulletAt hitp pt = pt
|
||||
& buPos .~ hitp +.+ normalizeV (p -.- hitp)
|
||||
& buOldPos .~ p
|
||||
& buVel .~ 0
|
||||
where
|
||||
p = _buPos pt
|
||||
stopBulletAt hitp pt =
|
||||
pt
|
||||
& buPos .~ hitp
|
||||
& buOldPos .~ _buPos pt
|
||||
& buVel .~ 0
|
||||
|
||||
movePenBullet ::
|
||||
Bullet ->
|
||||
[(Point2, Either Creature Wall)] ->
|
||||
World ->
|
||||
(World, Bullet)
|
||||
movePenBullet :: Bullet -> [(Point2, Either Creature Wall)] -> World -> (World, Bullet)
|
||||
movePenBullet bu hitstream w = case hitstream of
|
||||
[] -> (w, moveBullet bu)
|
||||
((p, crwl) : strm) ->
|
||||
if penThing crwl
|
||||
then first (damageThingHit bu (p, crwl)) $ movePenBullet bu strm w
|
||||
else expireAndDamage bu hitstream w
|
||||
((p, crwl) : strm) | penThing crwl ->
|
||||
first (damageThingHit bu (p, crwl)) $ movePenBullet bu strm w
|
||||
_ -> expireAndDamage bu hitstream w
|
||||
|
||||
penThing :: Either Creature Wall -> Bool
|
||||
penThing (Left _) = True
|
||||
|
||||
Reference in New Issue
Block a user