218 lines
8.2 KiB
Haskell
218 lines
8.2 KiB
Haskell
module Dodge.Bullet (updateBullet) where
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Dodge.Damage
|
|
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 LensHelp
|
|
import qualified ListHelp as List
|
|
import System.Random
|
|
import Linear
|
|
|
|
updateBullet :: World -> Bullet -> (World, Maybe Bullet)
|
|
updateBullet w bu
|
|
| norm (_buVel bu) < 10
|
|
, BulBall _ <- _buPayload bu =
|
|
(useBulletPayload bu (_buPos bu) w, Nothing)
|
|
| norm (_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
|
|
|
|
-- 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
|
|
| notclose = bu
|
|
| otherwise = case _mgField mg of
|
|
MagnetAlign -> doturntowards mgalignpos
|
|
MagnetDeflect -> doturntowards mgdeflectpos
|
|
MagnetAttract -> doturntowards mpos
|
|
MagnetRepulse -> doturntowards (2 * bpos - mpos)
|
|
where
|
|
notclose = d > 100
|
|
doturntowards p = bu & buVel %~ vecTurnTo (10 * pi / (d + 40)) bpos p
|
|
bvel = bu ^. buVel
|
|
mpos = mg ^. mgPos
|
|
bpos = bu ^. buPos
|
|
mgdeflectpos
|
|
| isLHS mpos (mpos + bvel) bpos = bpos + vNormal (bpos - mpos)
|
|
| otherwise = bpos - vNormal (bpos - mpos)
|
|
mgalignpos
|
|
| dotV bvel (bpos - mpos) > 0 = bpos - mpos
|
|
| otherwise = mpos - bpos
|
|
d = distance (bu ^. buPos) (mg ^. mgPos)
|
|
|
|
updateBulVel :: Bullet -> Bullet
|
|
updateBulVel bt = bt & buVel .*.*~ _buDrag 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
|
|
|
|
-- NOTE THE FOLLOWING HAS BEZIER CURE/FLECHETTE STUFF THAT MIGHT BE USEFUL
|
|
--shootBullet :: LabelDoubleTree ComposeLinkType Item -> Creature -> World -> World
|
|
--shootBullet itm cr w = fromMaybe (error "cannot find bullet ammo when expected to") $ do
|
|
-- atype <- itm ^? ldtValue . itUse . heldAmmoTypes . ix 0
|
|
-- leftitms <- itm ^? ldtLeft
|
|
-- mag <- lookup (AmmoInLink 0 atype) leftitms
|
|
-- thebullet <- mag ^? ldtValue . itUse . amagParams . ampBullet
|
|
-- return $ w
|
|
-- & randGen .~ g'
|
|
-- & cWorld . lWorld . instantBullets
|
|
-- .:~ ( thebullet
|
|
-- & buPos .~ _crPos cr
|
|
-- & buTrajectory %~ settrajectory
|
|
-- & buVel %~ (rotateV dir . (muzvel *.*))
|
|
-- & buDrag *~ drag
|
|
-- )
|
|
-- where
|
|
-- it = itm ^. ldtValue
|
|
-- sp = _crPos cr +.+ (muzlength ^?! _head . _x) *.* unitVectorAtAngle dir
|
|
-- dir = _crDir cr
|
|
-- (drag,g) = case _rifling (_heldParams $ _itUse it) of
|
|
-- ConstFloat x -> (x, _randGen w)
|
|
-- UniRandFloat x y -> randomR (x,y) $ _randGen w
|
|
-- (muzvel,g') = case _muzVel $ _heldParams $ _itUse it of
|
|
-- ConstFloat x -> (x,g)
|
|
-- UniRandFloat x y -> randomR (x,y) $ _randGen w
|
|
-- muzlength = aimingMuzzlePos cr it
|
|
-- settrajectory traj = case traj of
|
|
-- BasicBulletTrajectory -> BasicBulletTrajectory
|
|
-- MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
|
|
-- tpos <- cr ^? crTargeting . ctPos . _Just
|
|
-- return $ MagnetTrajectory tpos
|
|
-- FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
|
|
-- tpos <- cr ^? crTargeting . ctPos . _Just
|
|
-- return $ FlechetteTrajectory tpos
|
|
-- BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
|
|
-- tpos <- cr ^? crTargeting . ctPos . _Just
|
|
-- return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
|
|
|
|
-- might want to restrict what/how bounces by material type
|
|
bounceDir :: IM.IntMap Item -> (Point2, Either Creature Wall) -> Maybe Point2
|
|
bounceDir _ (_, Right wl) = Just $ uncurry (-) (_wlLine wl)
|
|
bounceDir m (p, Left cr) | crIsArmouredFrom m p cr
|
|
= Just $ vNormal $ p - (cr ^. crPos . _xy)
|
|
bounceDir _ _ = Nothing
|
|
|
|
useBulletPayload :: Bullet -> Point2 -> World -> World
|
|
useBulletPayload bu = case _buPayload bu of
|
|
BulPlain _ -> const id
|
|
BulFlak -> makeFlak bu
|
|
BulFrag -> makeFragBullets
|
|
BulGas -> (`makeGasCloud` V2 0 0)
|
|
BulBall ExplosiveBall -> makeMovingEB (_buVel bu) ExplosiveBall
|
|
BulBall ElectricalBall{} ->
|
|
makeMovingEB
|
|
(_buVel bu)
|
|
(ElectricalBall (round $ bu ^. buPos . _1))
|
|
BulBall FlashBall -> makeMovingEB (_buVel bu) FlashBall
|
|
BulBall (FlameletBall x) -> makeMovingEB (_buVel bu) (FlameletBall x)
|
|
BulBall IncendiaryBall -> makeMovingEB (_buVel bu) IncendiaryBall
|
|
|
|
makeFragBullets :: Point2 -> World -> World
|
|
makeFragBullets p w = w & cWorld . lWorld . bullets .++~ bus
|
|
where
|
|
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
|
|
& buPayload .~ BulPlain 5
|
|
& buVel .~ s *^ unitVectorAtAngle a
|
|
& buDrag .~ 0.8
|
|
& buPos .~ p
|
|
& buOldPos .~ p
|
|
|
|
makeFlak :: Bullet -> Point2 -> World -> World
|
|
makeFlak bu _ w = w & cWorld . lWorld . bullets .++~ [f x | x <- xs]
|
|
where
|
|
s = min 10 (0.5 * norm (_buVel bu))
|
|
xs = take 5 $ randomRs (- s, s) $ _randGen w
|
|
f x =
|
|
bu & buVel %~ g x
|
|
& buPayload .~ BulPlain 25
|
|
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 -> fromMaybe (expireAndDamage bu hitstream w) $ do
|
|
(hp, crwl) <- hitstream ^? _head
|
|
dir <- bounceDir (w ^. cWorld . lWorld . items) (hp, crwl)
|
|
return
|
|
( w
|
|
, bu
|
|
& buPos .~ hp + normalizeV (_buPos bu - hp)
|
|
& buVel %~ reflectIn dir
|
|
)
|
|
DestroyBullet -> expireAndDamage bu hitstream w
|
|
where
|
|
sp = _buPos bu
|
|
hitstream = thingsHitZ 20 sp (sp + _buVel bu) w
|
|
|
|
getBulHitDams :: Bullet -> Point2 -> [Damage]
|
|
getBulHitDams bu p = case _buPayload bu of
|
|
BulPlain x -> [Piercing x p v]
|
|
_ -> []
|
|
where
|
|
v = _buVel bu
|
|
|
|
damageThingHit :: Bullet -> (Point2, Either Creature Wall) -> World -> World
|
|
damageThingHit bu (p, crwl) = damageCrWl (getBulHitDams bu p) crwl
|
|
-- case crwl of
|
|
-- Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crDamage <>~ dams
|
|
-- Right wl -> cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty <>~ dams
|
|
-- where
|
|
-- dams = setFromToDams bu p
|
|
|
|
expireAndDamage ::
|
|
Bullet ->
|
|
[(Point2, Either Creature Wall)] ->
|
|
World ->
|
|
(World, Bullet)
|
|
expireAndDamage bt things w = case List.safeHead things of
|
|
Nothing -> (w, moveBullet bt)
|
|
Just x -> (damageThingHit bt x w, stopBulletAt (fst x) bt)
|
|
|
|
moveBullet :: Bullet -> Bullet
|
|
moveBullet pt = pt & buPos +~ _buVel pt & buOldPos .~ _buPos pt
|
|
|
|
stopBulletAt :: Point2 -> Bullet -> Bullet
|
|
stopBulletAt hitp pt = pt & buPos .~ hitp & buOldPos .~ _buPos pt & buVel .~ 0
|
|
|
|
movePenBullet :: Bullet -> [(Point2, Either Creature Wall)] -> World -> (World, Bullet)
|
|
movePenBullet bu hitstream w = case hitstream of
|
|
[] -> (w, moveBullet bu)
|
|
((p, crwl) : strm)
|
|
| penThing crwl ->
|
|
first (damageThingHit bu (p, crwl)) $ movePenBullet bu strm w
|
|
_ -> expireAndDamage bu hitstream w
|
|
|
|
materialPenetrable :: Material -> Bool
|
|
materialPenetrable _ = error "Haven't decided which materials are peneterable"
|
|
|
|
penThing :: Either Creature Wall -> Bool
|
|
penThing (Left _) = True
|
|
penThing (Right wl) = _wlStructure wl /= StandaloneWall
|
|
&& materialPenetrable (wl ^. wlMaterial)
|