111 lines
3.9 KiB
Haskell
111 lines
3.9 KiB
Haskell
module Dodge.Bullet where
|
|
import Dodge.Data
|
|
import Dodge.Creature.HandPos
|
|
import Dodge.Base.Coordinate
|
|
import Geometry
|
|
import LensHelp
|
|
|
|
import Data.Maybe
|
|
import Dodge.Movement.Turn
|
|
import Dodge.WorldEvent.ThingsHit
|
|
|
|
import Data.Bifunctor
|
|
|
|
updateBullet :: World -> Bullet -> (World,Maybe Bullet)
|
|
updateBullet w bu = case _buState bu of
|
|
DyingBulletState -> (w,Nothing)
|
|
DelayedBullet x -> mvBulletSlow x w bu
|
|
_ -> mvBullet w bu
|
|
|
|
aBulAt
|
|
:: Maybe Float -- ^ Start velocity step factor
|
|
-> Point2 -- ^ Start position
|
|
-> Point2 -- ^ Velocity
|
|
-> Float -- ^ Drag
|
|
-> HitEffect'
|
|
-> Float -- ^ Bullet width
|
|
-> BulletTrajectory
|
|
-> Bullet
|
|
aBulAt vfact pos vel drag hiteff width butraj = Bullet
|
|
{ _buState = bulstate
|
|
, _buUpdateMod = NoBulletUpdateMod
|
|
, _buTrajectory = butraj
|
|
, _buVel = vel
|
|
, _buDrag = drag
|
|
, _buPos = pos
|
|
, _buOldPos = pos
|
|
, _buWidth = width
|
|
, _buTimer = 100
|
|
, _buHitEff = hiteff
|
|
}
|
|
where
|
|
bulstate = maybe NormalBulletState DelayedBullet vfact
|
|
|
|
useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
|
|
useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
|
|
vfact
|
|
sp
|
|
(rotateV dir (muzvel *.* _amBulVel bultype)) -- vel
|
|
(_rifling $ _itParams it) -- drag
|
|
(_amBulEff bultype)
|
|
(_amBulWth bultype)
|
|
thetraj
|
|
where
|
|
sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
|
|
dir = _crDir cr
|
|
bultype = _laAmmoType $ _itConsumption it
|
|
muzvel = _muzVel $ _itParams it
|
|
muzlength = aimingMuzzlePos cr it
|
|
thetraj = case _amBulTraj bultype of
|
|
BasicBulletTrajectory -> BasicBulletTrajectory
|
|
MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
|
|
tpos <- it ^? itTargeting . tgPos . _Just
|
|
return $ MagnetTrajectory tpos
|
|
--return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos pt)
|
|
FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
|
|
tpos <- it ^? itTargeting . tgPos . _Just
|
|
return $ FlechetteTrajectory tpos
|
|
--return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (_buPos pt) tpos
|
|
BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
|
|
tpos <- it ^? itTargeting . tgPos . _Just
|
|
return $ BezierTrajectory sp tpos (mouseWorldPos w)
|
|
-- let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05
|
|
-- return $ \pt -> pt
|
|
-- & buVel .~ bf (fromIntegral $ _buTimer pt - 1) -.- bf (fromIntegral $ _buTimer pt)
|
|
|
|
{- Update for a generic bullet. -}
|
|
mvBullet :: World -> Bullet -> (World, Maybe Bullet)
|
|
mvBullet w bt'
|
|
| t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
|
|
| otherwise = second (fmap dodrag) $
|
|
hiteff bt (thingsHit p (p +.+ vel) w) w
|
|
where
|
|
bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
|
|
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 = _buHitEff bt
|
|
t = _buTimer bt
|
|
|
|
mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet)
|
|
mvBulletSlow x w bt'
|
|
| t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
|
|
| otherwise = second (fmap dodrag) $
|
|
hiteff bt (thingsHit p (p +.+ vel) w) w
|
|
where
|
|
bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
|
|
dodrag = (buVel .*.*~ drag)
|
|
. (buState .~ NormalBulletState)
|
|
drag = _buDrag bt
|
|
p = _buPos bt
|
|
vel = x *.* _buVel bt
|
|
hiteff = _buHitEff bt
|
|
t = _buTimer bt
|