Simplify bullet movement
This commit is contained in:
+23
-33
@@ -22,10 +22,8 @@ import Data.Bifunctor
|
|||||||
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
|
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
|
||||||
updateBullet w bu
|
updateBullet w bu
|
||||||
| magV (_buVel bu) < 1 = (endspawn w, Nothing)
|
| magV (_buVel bu) < 1 = (endspawn w, Nothing)
|
||||||
| otherwise =
|
-- have to be slightly carefull not to accelerate bullets using magnets
|
||||||
second (fmap updateBulVel)
|
| otherwise = second (Just . updateBulVel) . hitEffFromBul w $ applyMagnetsToBul bu w
|
||||||
. hitEffFromBul w
|
|
||||||
$ applyMagnetsToBul bu w
|
|
||||||
where
|
where
|
||||||
endspawn = fromMaybe id $ do
|
endspawn = fromMaybe id $ do
|
||||||
partspawn <- useBulletPayload bu
|
partspawn <- useBulletPayload bu
|
||||||
@@ -34,18 +32,19 @@ updateBullet w bu
|
|||||||
|
|
||||||
-- do we want this to drain energy from the deflection source?
|
-- do we want this to drain energy from the deflection source?
|
||||||
applyMagnetsToBul :: Bullet -> World -> Bullet
|
applyMagnetsToBul :: Bullet -> World -> Bullet
|
||||||
applyMagnetsToBul bu =
|
applyMagnetsToBul bu = foldl' doMagnetBuBu bu . _oldMagnets . _lWorld . _cWorld
|
||||||
foldl' (flip doMagnetBuBu) bu . _oldMagnets . _lWorld . _cWorld
|
|
||||||
|
|
||||||
doMagnetBuBu :: Magnet -> Bullet -> Bullet
|
doMagnetBuBu :: Bullet -> Magnet -> Bullet
|
||||||
doMagnetBuBu mg bu = if isclose
|
doMagnetBuBu bu mg
|
||||||
then case _mgField mg of
|
| notclose = bu
|
||||||
MagnetAlign -> bu & buVel %~ vecTurnTo (10 * pi / (d+40)) bpos mgalignpos
|
| otherwise = case _mgField mg of
|
||||||
MagnetDeflect -> bu & buVel %~ vecTurnTo (10 * pi / (d+40)) bpos mgdeflectpos
|
MagnetAlign -> doturntowards mgalignpos
|
||||||
MagnetAttract -> bu & buVel %~ vecTurnTo (10 * pi / (d+40)) bpos mpos
|
MagnetDeflect -> doturntowards mgdeflectpos
|
||||||
MagnetRepulse -> bu & buVel %~ vecTurnTo (10 * pi / (d+40)) bpos (2*bpos - mpos)
|
MagnetAttract -> doturntowards mpos
|
||||||
else bu
|
MagnetRepulse -> doturntowards (2*bpos - mpos)
|
||||||
where
|
where
|
||||||
|
notclose = d > 100
|
||||||
|
doturntowards p = bu & buVel %~ vecTurnTo (10 * pi / (d+40)) bpos p
|
||||||
bvel = bu ^. buVel
|
bvel = bu ^. buVel
|
||||||
mpos = mg ^. mgPos
|
mpos = mg ^. mgPos
|
||||||
bpos = bu ^. buPos
|
bpos = bu ^. buPos
|
||||||
@@ -56,10 +55,9 @@ doMagnetBuBu mg bu = if isclose
|
|||||||
| dotV bvel (bpos - mpos) > 0 = bpos - mpos
|
| dotV bvel (bpos - mpos) > 0 = bpos - mpos
|
||||||
| otherwise = mpos - bpos
|
| otherwise = mpos - bpos
|
||||||
d = dist (bu ^. buPos) (mg ^. mgPos)
|
d = dist (bu ^. buPos) (mg ^. mgPos)
|
||||||
isclose = d < 100
|
|
||||||
|
|
||||||
updateBulVel :: Bullet -> Bullet
|
updateBulVel :: Bullet -> Bullet
|
||||||
updateBulVel bt = bt & buVel .*.*~ _buDrag bt
|
updateBulVel bt = bt & buVel .*.*~ _buDrag bt
|
||||||
--case _buTrajectory bt of
|
--case _buTrajectory bt of
|
||||||
-- BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag bt
|
-- BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag bt
|
||||||
-- MagnetTrajectory tpos -> bt
|
-- MagnetTrajectory tpos -> bt
|
||||||
@@ -155,10 +153,7 @@ makeFlak bu _ w = w & cWorld . lWorld . bullets .++~ [f x | x <- xs]
|
|||||||
]
|
]
|
||||||
g x v = v +.+ x *.* normalizeV (vNormal v)
|
g x v = v +.+ x *.* normalizeV (vNormal v)
|
||||||
|
|
||||||
hitEffFromBul ::
|
hitEffFromBul :: World -> Bullet -> (World, Bullet)
|
||||||
World ->
|
|
||||||
Bullet ->
|
|
||||||
(World, Maybe Bullet)
|
|
||||||
hitEffFromBul w bu = case _buEffect bu of
|
hitEffFromBul w bu = case _buEffect bu of
|
||||||
PenetrateBullet -> movePenBullet bu hitstream w
|
PenetrateBullet -> movePenBullet bu hitstream w
|
||||||
BounceBullet -> case List.safeHead hitstream of
|
BounceBullet -> case List.safeHead hitstream of
|
||||||
@@ -167,8 +162,7 @@ hitEffFromBul w bu = case _buEffect bu of
|
|||||||
dir <- bounceDir (hp, crwl)
|
dir <- bounceDir (hp, crwl)
|
||||||
return
|
return
|
||||||
( w
|
( w
|
||||||
, Just $
|
, bu
|
||||||
bu
|
|
||||||
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
|
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
|
||||||
& buVel %~ reflectIn dir
|
& buVel %~ reflectIn dir
|
||||||
-- & buTrajectory .~ BasicBulletTrajectory
|
-- & buTrajectory .~ BasicBulletTrajectory
|
||||||
@@ -196,22 +190,18 @@ expireAndDamage ::
|
|||||||
Bullet ->
|
Bullet ->
|
||||||
[(Point2, Either Creature Wall)] ->
|
[(Point2, Either Creature Wall)] ->
|
||||||
World ->
|
World ->
|
||||||
(World, Maybe Bullet)
|
(World, Bullet)
|
||||||
expireAndDamage bt things w = case List.safeHead things of
|
expireAndDamage bt things w = case List.safeHead things of
|
||||||
Nothing -> (w, moveBullet bt)
|
Nothing -> (w, moveBullet bt)
|
||||||
Just x -> (damageThingHit bt x w, destroyAt (fst x) bt)
|
Just x -> (damageThingHit bt x w, stopBulletAt (fst x) bt)
|
||||||
|
|
||||||
moveBullet :: Bullet -> Maybe Bullet
|
moveBullet :: Bullet -> Bullet
|
||||||
moveBullet pt =
|
moveBullet pt = pt
|
||||||
Just $
|
|
||||||
pt
|
|
||||||
& buPos %~ (+.+ _buVel pt)
|
& buPos %~ (+.+ _buVel pt)
|
||||||
& buOldPos .~ _buPos pt
|
& buOldPos .~ _buPos pt
|
||||||
|
|
||||||
destroyAt :: Point2 -> Bullet -> Maybe Bullet
|
stopBulletAt :: Point2 -> Bullet -> Bullet
|
||||||
destroyAt hitp pt =
|
stopBulletAt hitp pt = pt
|
||||||
Just $
|
|
||||||
pt
|
|
||||||
& buPos .~ hitp +.+ normalizeV (p -.- hitp)
|
& buPos .~ hitp +.+ normalizeV (p -.- hitp)
|
||||||
& buOldPos .~ p
|
& buOldPos .~ p
|
||||||
& buVel .~ 0
|
& buVel .~ 0
|
||||||
@@ -222,7 +212,7 @@ movePenBullet ::
|
|||||||
Bullet ->
|
Bullet ->
|
||||||
[(Point2, Either Creature Wall)] ->
|
[(Point2, Either Creature Wall)] ->
|
||||||
World ->
|
World ->
|
||||||
(World, Maybe Bullet)
|
(World, Bullet)
|
||||||
movePenBullet bu hitstream w = case hitstream of
|
movePenBullet bu hitstream w = case hitstream of
|
||||||
[] -> (w, moveBullet bu)
|
[] -> (w, moveBullet bu)
|
||||||
((p, crwl) : strm) ->
|
((p, crwl) : strm) ->
|
||||||
|
|||||||
Reference in New Issue
Block a user