Files
loop/src/Dodge/Particle/Bullet/Update.hs
T

65 lines
2.0 KiB
Haskell

--{-# LANGUAGE TupleSections #-}
{- Bullet update. -}
module Dodge.Particle.Bullet.Update
( mvBullet
, mvBulletSlow
, mvSpark
) where
import Dodge.Data
import Dodge.Movement.Turn
import Dodge.WorldEvent.ThingsHit
--import Picture
import Geometry
import LensHelp
import Data.Bifunctor
{- 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
mvSpark :: World -> Particle -> (World, Maybe Particle)
mvSpark w bt'
| t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
| otherwise = second (fmap dodrag) $
hiteff bt (thingsHit p (p +.+ vel) w) w
where
bt = bt'
dodrag = ptVel .*.*~ drag
drag = _ptDrag bt
(p:_) = _ptTrail bt
vel = _ptVel bt
hiteff = _ptHitEff bt
t = _ptTimer bt