Cleanup
This commit is contained in:
+109
-87
@@ -1,40 +1,70 @@
|
||||
module Dodge.Bullet
|
||||
( updateBullet
|
||||
, useAmmoParams
|
||||
) where
|
||||
import Dodge.MagnetBuBu
|
||||
import qualified ListHelp as List
|
||||
import Dodge.EnergyBall
|
||||
module Dodge.Bullet (
|
||||
updateBullet,
|
||||
useAmmoParams,
|
||||
) where
|
||||
|
||||
import Data.Maybe
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.Creature.HandPos
|
||||
import Dodge.Creature.Test
|
||||
import Dodge.Data
|
||||
import Dodge.Creature.HandPos
|
||||
import Dodge.Base.Coordinate
|
||||
import Dodge.EnergyBall
|
||||
import Dodge.MagnetBuBu
|
||||
import Dodge.Movement.Turn
|
||||
import Dodge.WorldEvent.SpawnParticle
|
||||
import Dodge.WorldEvent.ThingsHit
|
||||
import Geometry
|
||||
import qualified IntMapHelp as IM
|
||||
import LensHelp
|
||||
import qualified ListHelp as List
|
||||
import StreamingHelp
|
||||
|
||||
import qualified IntMapHelp as IM
|
||||
import Data.Maybe
|
||||
import Dodge.Movement.Turn
|
||||
import Dodge.WorldEvent.ThingsHit
|
||||
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
|
||||
updateBullet w bu = case _buDelayFraction bu of
|
||||
1 -> mvBullet 1 w bu
|
||||
x -> mvBullet x w (bu & buDelayFraction .~ 1)
|
||||
|
||||
updateBullet :: World -> Bullet -> (World,Maybe Bullet)
|
||||
updateBullet w bu = case _buState bu of
|
||||
DelayedBullet x -> mvBullet x w bu
|
||||
_ -> mvBullet 1 w bu
|
||||
mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
|
||||
mvBullet x w bu
|
||||
| _buTimer bu <= 0 || magV (_buVel bu) < 1 = (endspawn w, Nothing)
|
||||
| otherwise =
|
||||
second (fmap updateBulVel)
|
||||
. hitEffFromBul x w
|
||||
$ applyMagnetsToBul bu w
|
||||
where
|
||||
endspawn = fromMaybe id $ do
|
||||
partspawn <- bulletSpawn bu
|
||||
return $ partspawn p
|
||||
p = _buPos bu
|
||||
|
||||
applyMagnetsToBul :: Bullet -> World -> Bullet
|
||||
applyMagnetsToBul bu =
|
||||
foldr (\mg -> doMagnetBuBu (_mgField mg) mg) bu . _magnets . _cWorld
|
||||
|
||||
updateBulVel :: Bullet -> Bullet
|
||||
updateBulVel bt = case _buTrajectory bt of
|
||||
BasicBulletTrajectory -> bt & buVel .*.*~ _buDrag 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 ->
|
||||
let bf tm = bQuadToF (spos, xpos, tpos) $ (100 - tm) * 0.05
|
||||
in bt & buVel .~ bf (fromIntegral $ t - 1) -.- bf (fromIntegral t)
|
||||
where
|
||||
t = _buTimer bt
|
||||
|
||||
useAmmoParams :: Item -> Creature -> World -> World
|
||||
useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
|
||||
& buPos .~ sp
|
||||
& buTrajectory %~ settrajectory
|
||||
& buVel %~ (rotateV dir . (muzvel *.*))
|
||||
& buDrag *~ _rifling (_itParams it)
|
||||
)
|
||||
useAmmoParams it cr w =
|
||||
w & cWorld . instantBullets
|
||||
.:~ ( _amBullet bultype
|
||||
& buPos .~ sp
|
||||
& buTrajectory %~ settrajectory
|
||||
& buVel %~ (rotateV dir . (muzvel *.*))
|
||||
& buDrag *~ _rifling (_itParams it)
|
||||
)
|
||||
where
|
||||
sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
|
||||
dir = _crDir cr
|
||||
bultype = _laAmmoType $ _itConsumption it
|
||||
bultype = _laAmmoType $ _heldConsumption $ _itUse it
|
||||
muzvel = _muzVel $ _itParams it
|
||||
muzlength = aimingMuzzlePos cr it
|
||||
settrajectory traj = case traj of
|
||||
@@ -49,35 +79,9 @@ useAmmoParams it cr w = w & cWorld . instantBullets .:~ (_amBullet bultype
|
||||
tpos <- it ^? itTargeting . tgPos . _Just
|
||||
return $ BezierTrajectory sp tpos (mouseWorldPos w)
|
||||
|
||||
{- Update for a generic bullet. -}
|
||||
mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
|
||||
mvBullet x w bt'
|
||||
| t <= 0 || magV (_buVel bt) < 1 = (endspawn w,Nothing)
|
||||
| otherwise = second (fmap dodrag) $
|
||||
hiteff bt hitstream w
|
||||
where
|
||||
endspawn w' = fromMaybe w' $ do
|
||||
partspawn <- bulletSpawn bt'
|
||||
return $ partspawn p w'
|
||||
hitstream = thingsHit p (p +.+ vel) w
|
||||
bt = foldr (\mg b -> doMagnetBuBu (_mgField mg) mg b) bt' (_magnets (_cWorld w))
|
||||
& buState .~ NormalBulletState
|
||||
dodrag = case _buTrajectory bt of
|
||||
BasicBulletTrajectory -> buVel .*.*~ drag
|
||||
MagnetTrajectory tpos -> buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos bt)
|
||||
FlechetteTrajectory tpos -> buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
|
||||
BezierTrajectory spos tpos xpos ->
|
||||
let bf tm = bQuadToF (spos,xpos,tpos) $ (100 - tm) * 0.05
|
||||
in buVel .~ bf (fromIntegral $ _buTimer bt - 1) -.- bf (fromIntegral $ _buTimer bt)
|
||||
drag = _buDrag bt
|
||||
p = _buPos bt
|
||||
vel = _buVel bt
|
||||
hiteff = hitEffFromBul x
|
||||
t = _buTimer bt
|
||||
|
||||
bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
|
||||
bounceDir (_,Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
|
||||
bounceDir (p,Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
|
||||
bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
|
||||
bounceDir (p, Left cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
|
||||
bounceDir _ = Nothing
|
||||
|
||||
bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
|
||||
@@ -87,66 +91,84 @@ bulletSpawn bu = case _buSpawn bu of
|
||||
BulBall ConcBall -> Just $ \p -> cWorld . shockwaves .:~ concBall p
|
||||
BulBall TeslaBall -> Just makeStaticBall
|
||||
|
||||
hitEffFromBul :: Float -> Bullet
|
||||
-> [(Point2, Either Creature Wall)]
|
||||
-> World
|
||||
-> (World,Maybe Bullet)
|
||||
hitEffFromBul x bu hitstream w = case _buEffect bu of
|
||||
hitEffFromBul ::
|
||||
Float ->
|
||||
World ->
|
||||
Bullet ->
|
||||
(World, Maybe Bullet)
|
||||
hitEffFromBul x w bu = case _buEffect bu of
|
||||
PenetrateBullet -> movePenBullet x bu hitstream w
|
||||
BounceBullet -> case List.safeHead hitstream of
|
||||
BounceBullet -> case List.safeHead hitstream of
|
||||
Nothing -> (w, moveBullet x bu)
|
||||
Just (hp,crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
|
||||
dir <- bounceDir (hp,crwl)
|
||||
return (w,Just $ bu
|
||||
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
|
||||
& buVel %~ reflectIn dir
|
||||
& buTrajectory .~ BasicBulletTrajectory
|
||||
& buTimer -~ 1
|
||||
Just (hp, crwl) -> fromMaybe (expireAndDamage x bu hitstream w) $ do
|
||||
dir <- bounceDir (hp, crwl)
|
||||
return
|
||||
( w
|
||||
, Just $
|
||||
bu
|
||||
& buPos .~ hp +.+ normalizeV (_buPos bu -.- hp)
|
||||
& buVel %~ reflectIn dir
|
||||
& buTrajectory .~ BasicBulletTrajectory
|
||||
& buTimer -~ 1
|
||||
)
|
||||
DestroyBullet -> expireAndDamage x bu hitstream w
|
||||
where
|
||||
ep = sp +.+ x *.* _buVel bu
|
||||
sp = _buPos bu
|
||||
hitstream = thingsHit sp ep w
|
||||
|
||||
setFromToDams :: Bullet -> Point2 -> [Damage]
|
||||
setFromToDams bu p = map f (_buDamages bu)
|
||||
where
|
||||
f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
|
||||
|
||||
damageThingHit :: Bullet -> (Point2,Either Creature Wall) -> World -> World
|
||||
damageThingHit bu (p,crwl) = case crwl of
|
||||
damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
|
||||
damageThingHit bu (p, crwl) = case crwl of
|
||||
Left cr -> cWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
||||
Right wl -> cWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
||||
where
|
||||
dams = setFromToDams bu p
|
||||
|
||||
expireAndDamage :: Float
|
||||
-> Bullet
|
||||
-> [(Point2, Either Creature Wall)]
|
||||
-> World
|
||||
-> (World, Maybe Bullet)
|
||||
|
||||
expireAndDamage ::
|
||||
Float ->
|
||||
Bullet ->
|
||||
[(Point2, Either Creature Wall)] ->
|
||||
World ->
|
||||
(World, Maybe Bullet)
|
||||
expireAndDamage y bt things w = case List.safeHead things of
|
||||
Nothing -> (w, moveBullet y bt)
|
||||
Just x -> (damageThingHit bt x w, destroyAt (fst x) bt)
|
||||
|
||||
moveBullet :: Float -> Bullet -> Maybe Bullet
|
||||
moveBullet x pt = Just $ pt
|
||||
& buPos %~ (+.+ x *.* _buVel pt)
|
||||
& buOldPos .~ _buPos pt
|
||||
& buTimer -~ 1
|
||||
moveBullet x pt =
|
||||
Just $
|
||||
pt
|
||||
& buPos %~ (+.+ x *.* _buVel pt)
|
||||
& buOldPos .~ _buPos pt
|
||||
& buTimer -~ 1
|
||||
|
||||
destroyAt :: Point2 -> Bullet -> Maybe Bullet
|
||||
destroyAt hitp pt = Just $ pt
|
||||
& buPos .~ hitp +.+ normalizeV (p -.- hitp)
|
||||
& buOldPos .~ p
|
||||
& buVel .~ 0
|
||||
destroyAt hitp pt =
|
||||
Just $
|
||||
pt
|
||||
& buPos .~ hitp +.+ normalizeV (p -.- hitp)
|
||||
& buOldPos .~ p
|
||||
& buVel .~ 0
|
||||
where
|
||||
p = _buPos pt
|
||||
|
||||
movePenBullet :: Float -> Bullet -> [(Point2, Either Creature Wall)]
|
||||
-> World -> (World, Maybe Bullet)
|
||||
movePenBullet ::
|
||||
Float ->
|
||||
Bullet ->
|
||||
[(Point2, Either Creature Wall)] ->
|
||||
World ->
|
||||
(World, Maybe Bullet)
|
||||
movePenBullet x bu hitstream w = case hitstream of
|
||||
[] -> (w,moveBullet x bu)
|
||||
((p,crwl):strm) -> if penThing crwl
|
||||
then first (damageThingHit bu (p,crwl)) $ movePenBullet x bu strm w
|
||||
else expireAndDamage x bu hitstream w
|
||||
[] -> (w, moveBullet x bu)
|
||||
((p, crwl) : strm) ->
|
||||
if penThing crwl
|
||||
then first (damageThingHit bu (p, crwl)) $ movePenBullet x bu strm w
|
||||
else expireAndDamage x bu hitstream w
|
||||
|
||||
penThing :: Either Creature Wall -> Bool
|
||||
penThing (Left _) = True
|
||||
|
||||
Reference in New Issue
Block a user