diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index ef8df1845..536bb6edb 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -1,12 +1,15 @@ module Dodge.Bullet where import Dodge.Data -import Dodge.Particle.Bullet.Update 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 @@ -16,7 +19,6 @@ updateBullet w bu = case _buState bu of aBulAt :: Maybe Float -- ^ Start velocity step factor --- -> (Bullet -> Bullet) -> Point2 -- ^ Start position -> Point2 -- ^ Velocity -> Float -- ^ Drag @@ -24,8 +26,7 @@ aBulAt -> Float -- ^ Bullet width -> BulletTrajectory -> Bullet -aBulAt vfact --updatemod - pos vel drag hiteff width butraj = Bullet +aBulAt vfact pos vel drag hiteff width butraj = Bullet { _buState = bulstate , _buUpdateMod = NoBulletUpdateMod , _buTrajectory = butraj @@ -38,19 +39,17 @@ aBulAt vfact --updatemod , _buHitEff = hiteff } where - bulstate = fromMaybe NormalBulletState $ DelayedBullet <$> vfact + bulstate = maybe NormalBulletState DelayedBullet vfact useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt vfact --- thetraj -- extra update sp (rotateV dir (muzvel *.* _amBulVel bultype)) -- vel (_rifling $ _itParams it) -- drag (_amBulEff bultype) (_amBulWth bultype) thetraj --- (_amBulTraj bultype) where sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir dir = _crDir cr @@ -73,3 +72,39 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt -- 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 diff --git a/src/Dodge/Particle/Bullet/Draw.hs b/src/Dodge/Bullet/Draw.hs similarity index 87% rename from src/Dodge/Particle/Bullet/Draw.hs rename to src/Dodge/Bullet/Draw.hs index 374ea8760..a33ec38cf 100644 --- a/src/Dodge/Particle/Bullet/Draw.hs +++ b/src/Dodge/Bullet/Draw.hs @@ -1,4 +1,4 @@ -module Dodge.Particle.Bullet.Draw +module Dodge.Bullet.Draw ( drawBul ) where import Dodge.Data diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 9fce36ccd..c2becd6bb 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -1,7 +1,7 @@ module Dodge.Creature.Damage where import Dodge.Data import Dodge.Creature.Test -import Dodge.Particle.Spark +import Dodge.Spark import Dodge.Bullet import Color import Geometry diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 87cf62cdb..e2840c8b2 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -11,8 +11,7 @@ import Dodge.Data import Dodge.Creature.Lamp import Dodge.WorldEvent.Explosion import Dodge.Creature.Picture ---import Dodge.Creature.Stance.Data -import Dodge.Particle.Spark +import Dodge.Spark import Dodge.Default import Dodge.Creature.State import Picture diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8bf1e1790..b55b71aaf 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -539,8 +539,14 @@ data Bullet = Bullet , _buOldPos :: Point2 , _buWidth :: Float , _buTimer :: Int +-- , _buEffect :: BulletEffect , _buHitEff :: HitEffect' } +data BulletEffect = BulletSpark + | BulletBounce + | BulletBall EnergyBall + +data EnergyBall = IncBall | TeslaBall | ConcBall {- Objects without ids. Update themselves, perhaps with side effects. -} diff --git a/src/Dodge/Material/Damage.hs b/src/Dodge/Material/Damage.hs index 8fc7b5239..96b33482e 100644 --- a/src/Dodge/Material/Damage.hs +++ b/src/Dodge/Material/Damage.hs @@ -1,14 +1,7 @@ module Dodge.Material.Damage where import Dodge.Data -import Dodge.Particle.Spark ---import Dodge.Particle.Bullet.Spawn ---import Dodge.Base.Wall ---import Dodge.Wall.Dust ---import Dodge.Block +import Dodge.Spark import Geometry ---import LensHelp - ---import Control.Monad.State damageMaterial :: Damage -> Material -> Float -- the angle of the hit surface, in radians diff --git a/src/Dodge/Particle/Bullet/Update.hs b/src/Dodge/Particle/Bullet/Update.hs deleted file mode 100644 index 686d5b3c8..000000000 --- a/src/Dodge/Particle/Bullet/Update.hs +++ /dev/null @@ -1,64 +0,0 @@ ---{-# 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 diff --git a/src/Dodge/Particle/TeslaArc.hs b/src/Dodge/Particle/TeslaArc.hs index f92fec55e..035ca98d5 100644 --- a/src/Dodge/Particle/TeslaArc.hs +++ b/src/Dodge/Particle/TeslaArc.hs @@ -3,22 +3,12 @@ module Dodge.Particle.TeslaArc ) where import Dodge.Data import Dodge.Damage ---import Dodge.WorldEvent.Damage ---import Dodge.Base ---import Dodge.Zone ---import Dodge.Base.Collide -import Dodge.Particle.Spark ---import Dodge.WorldEvent.ThingsHit +import Dodge.Spark import RandomHelp import Picture import Geometry ---import qualified IntMapHelp as IM import LensHelp ---import Data.Function (on) ---import Data.List ---import Data.Maybe - aTeslaArcAt :: Color -> [ArcStep] -> Particle aTeslaArcAt col thearc = PtTeslaArc { _ptPoints = map (^. asPos) thearc diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index f53999348..833e30195 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -5,7 +5,7 @@ import Dodge.Item.Draw.SPic import Dodge.Creature.Picture.Awareness import Dodge.Creature.Picture import Dodge.Particle.Draw -import Dodge.Particle.Bullet.Draw +import Dodge.Bullet.Draw import Dodge.RadarBlip import Dodge.Flare import Dodge.ShortShow diff --git a/src/Dodge/Particle/Spark.hs b/src/Dodge/Spark.hs similarity index 80% rename from src/Dodge/Particle/Spark.hs rename to src/Dodge/Spark.hs index 0690f2572..7d740fac2 100644 --- a/src/Dodge/Particle/Spark.hs +++ b/src/Dodge/Spark.hs @@ -1,21 +1,37 @@ -module Dodge.Particle.Spark - ( colSpark +module Dodge.Spark + ( mvSpark + , colSpark , colSparkRandDir , createBarrelSpark , randColDirTimeSpark ) where import Dodge.Data -import Dodge.Particle.HitEffect.ExpireAndDamage -import Dodge.Particle.Damage ---import Dodge.Particle.Bullet.HitEffect -import Dodge.Particle.Bullet.Update ---import Dodge.WorldEvent.HitEffect -import Color +import Dodge.WorldEvent.ThingsHit import Geometry import LensHelp +import Dodge.Particle.HitEffect.ExpireAndDamage +import Dodge.Particle.Damage +import Color import Control.Monad.State import System.Random + +import Data.Bifunctor + +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 + --import Control.Lens -- TODO remove/simplify this function createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e4862d0ea..6a4996245 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -218,7 +218,7 @@ updateFlares = flares %~ mapMaybe updateFlare updateBullets :: World -> World updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w' where - (w',ps) = mapAccumR (\a b -> updateBullet a b) w $ _bullets w + (w',ps) = mapAccumR updateBullet w $ _bullets w {- Apply internal particle updates, delete 'Nothing's. -} updateParticles :: World -> World @@ -298,7 +298,7 @@ intersectSegSegs' _ _ _ = Nothing updateInstantBullets :: World -> World updateInstantBullets w = case _instantBullets w of [] -> w - ps -> let (w',ps') = mapAccumR (\a b -> updateBullet a b) (w {_instantBullets=[]}) ps + ps -> let (w',ps') = mapAccumR updateBullet (w {_instantBullets=[]}) ps in updateInstantBullets $ w' & bullets .++~ catMaybes ps' updateInstantParticles :: World -> World diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index 46cbb7d63..5c7a2cc45 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -1,7 +1,7 @@ module Dodge.Wall.DamageEffect where import Dodge.Data import Dodge.Bullet -import Dodge.Particle.Spark +import Dodge.Spark import Dodge.Base.Wall import Dodge.Wall.Dust import Dodge.Block