227 lines
7.8 KiB
Haskell
227 lines
7.8 KiB
Haskell
module Dodge.Bullet (
|
|
updateBullet,
|
|
-- shootBullet,
|
|
) where
|
|
|
|
--import Dodge.Data.ComposedItem
|
|
--import Dodge.Data.DoubleTree
|
|
import Linear
|
|
import Dodge.Item.Weapon.Bullet
|
|
import System.Random
|
|
import Data.Foldable
|
|
import Data.Maybe
|
|
--import Dodge.Base.Coordinate
|
|
--import Dodge.Creature.HandPos
|
|
import Dodge.Creature.Test
|
|
import Dodge.Data.World
|
|
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 Data.Bifunctor
|
|
|
|
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)
|
|
|
|
mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet)
|
|
mvBullet x w bu
|
|
| magV (_buVel bu) < 1 || _buTimer bu <= 0 = (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 =
|
|
foldl' (flip doMagnetBuBu) bu . _magnets . _lWorld . _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
|
|
|
|
-- 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))
|
|
|
|
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 _ = Nothing
|
|
|
|
bulletSpawn :: Bullet -> Maybe (Point2 -> World -> World)
|
|
bulletSpawn bu = case _buSpawn 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
|
|
|
|
makeFragBullets :: Point2 -> World -> World
|
|
makeFragBullets p w = w & cWorld . lWorld . instantBullets .++~ 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 & 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 . instantBullets .++~ [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
|
|
& buSpawn .~ BulSpark
|
|
& buWidth .~ 0.5
|
|
& buDamages .~
|
|
[ Damage PIERCING 25 0 0 0 $ PushBackDamage 2
|
|
]
|
|
g x v = v +.+ x *.* normalizeV (vNormal v)
|
|
|
|
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
|
|
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
|
|
)
|
|
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
|
|
Left cr -> cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .++~ dams
|
|
Right wl -> cWorld . lWorld . wallDamages %~ IM.insertWith (++) (_wlID wl) dams
|
|
where
|
|
dams = setFromToDams bu p
|
|
|
|
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
|
|
|
|
destroyAt :: Point2 -> Bullet -> Maybe Bullet
|
|
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 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
|
|
|
|
penThing :: Either Creature Wall -> Bool
|
|
penThing (Left _) = True
|
|
penThing (Right wl) = _wlPenetrable wl
|