Unify bullet creation

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -51,7 +51,7 @@ bulBounceArmCr' bt p cr w
     pOut = p +.+ 2 *.* newDir
     reflectVel = magV bulVel *.* newDir
     addBouncer = instantParticles .:~ bouncer
-    bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt)
+    bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
                                       (_ptHitEff bt) (_ptWidth bt)
               ) {_ptTimer = _ptTimer bt - 1}
 {- | Bullet pass through creatures.  -}
@@ -70,7 +70,7 @@ bulPenCr' bt p cr w = w
     cid = _crID cr
     sp = head $ _ptTrail bt
     ep = sp +.+ _ptVel bt
-    piercer = (aGenBulAt (Just cid) p (_ptVel bt) (_btDrag bt)
+    piercer = (aBulAt Nothing id (Just (_ptColor bt)) (Just cid) p (_ptVel bt) (_btDrag bt)
                                       (_ptHitEff bt) (_ptWidth bt)
               ) {_ptTimer = _ptTimer bt - 1}
 {- | Heavy bullet effects when hitting creature:
@@ -123,7 +123,7 @@ bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl
     ep = sp +.+ _ptVel bt
     sp = head $ _ptTrail bt
     pOut = p +.+ squashNormalizeV (sp -.- p)
-    bouncer = (aGenBulAt Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
+    bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
               ) {_ptTimer = _ptTimer bt - 1}
     reflectVel = reflVelWall wl (_ptVel bt)
 -- the hack is to get around the fact that the particles list gets reset after

src/Dodge/Particle/Bullet/Spawn.hs

@@ -1,41 +1,20 @@
 module Dodge.Particle.Bullet.Spawn
-    ( aGenBulAt
-    , aDelayedBulAt
-    , aCurveBulAt
-    , accelBulAt
+    ( aBulAt
     ) where
 import Dodge.Data
 import Dodge.Particle.Bullet.Draw
 import Dodge.Particle.Bullet.Update
-import Dodge.Movement.Turn
 import Geometry
 import Picture
 import LensHelp
 
+import Data.Maybe
 import Data.Bifunctor
 
-aGenBulAt
-    :: Maybe Int -- ^ Pass-through creature id
-    -> Point2   -- ^ Start position
-    -> Point2  -- ^ Velocity
-    -> Float   -- ^ Slowdown
-    -> HitEffect 
-    -> Float    -- ^ Bullet width
-    -> Particle
-aGenBulAt maycid pos vel drag hiteff width = BulletPt
-    { _ptDraw = drawBul
-    , _ptUpdate = mvBullet
-    , _ptVel    = vel
-    , _btDrag   = drag
-    , _ptColor = V4 2 2 2 2
-    , _ptTrail = [pos]
-    , _ptCrIgnore = maycid
-    , _ptWidth = width
-    , _ptTimer = 100
-    , _ptHitEff = hiteff
-    }
-aDelayedBulAt
-    :: Float    -- ^ Start velocity step factor
+aBulAt
+    :: Maybe Float    -- ^ Start velocity step factor
+    -> (Particle -> Particle)
+    -> Maybe Color
     -> Maybe Int -- ^ Pass-through creature id
     -> Point2   -- ^ Start position
     -> Point2  -- ^ Velocity
@@ -43,12 +22,13 @@ aDelayedBulAt
     -> HitEffect 
     -> Float    -- ^ Bullet width
     -> Particle
-aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt
+aBulAt vfact updatemod mcol maycid pos vel drag hiteff width = BulletPt
     { _ptDraw = drawBul
-    , _ptUpdate = \w -> resetVel . mvBullet w
-    , _ptVel  = vfact *.* vel
+    , _ptUpdate = theupdate
+    , _ptVel  = fromMaybe 1 vfact *.* vel
     , _btDrag = drag
-    , _ptColor = V4 2 2 2 2
+    , _ptColor = fromMaybe (V4 200 200 200 2) mcol
+--    , _ptColor = V4 2 2 2 2
     , _ptTrail = [pos]
     , _ptCrIgnore = maycid
     , _ptWidth = width
@@ -56,78 +36,7 @@ aDelayedBulAt vfact maycid pos vel drag hiteff width = BulletPt
     , _ptHitEff = hiteff
     }
   where
-    resetVel = second $ fmap $ (ptUpdate .~ mvBullet) . (ptVel .~ vel)
-
-aCurveBulAt 
-    :: Maybe Int -- ^ Pass-through creature id
-    -> Color 
-    -> Point2   -- ^ Start position
-    -> Point2   -- ^ Control position
-    -> Point2   -- ^ Target position
-    -> HitEffect 
-    -> Float    -- ^ Bullet width
-    -> Particle
-aCurveBulAt maycid col pos control targ hiteff width = BulletPt
-    { _ptDraw = drawBul
-    , _ptUpdate = \w -> mvBullet w . setVel
-    , _ptVel  = V2 0 0
-    , _btDrag = 1
-    , _ptColor = col
-    , _ptTrail = [pos]
-    , _ptCrIgnore = maycid
-    , _ptWidth = width
-    , _ptTimer = 100
-    , _ptHitEff = hiteff
-    }
-  where 
-    setVel pt = pt & ptVel .~ bf (fromIntegral $ _ptTimer pt - 1) -.- bf (fromIntegral $ _ptTimer pt)
-    bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05
-
-accelBulAt 
-    :: Maybe Int -- ^ Pass-through creature id
-    -> Color 
-    -> Point2   -- ^ Start position
-    -> Point2  -- ^ Velocity
-    -> Point2   -- ^ Acceleration
-    -> HitEffect 
-    -> Float    -- ^ Bullet width
-    -> Particle
-accelBulAt maycid col pos vel acc hiteff width = BulletPt
-    { _ptDraw = drawBul
-    , _ptUpdate = \w -> mvBullet w . setVel
-    , _ptVel  = vel
-    , _btDrag = 1
-    , _ptColor = col
-    , _ptTrail = [pos]
-    , _ptCrIgnore = maycid
-    , _ptWidth = width
-    , _ptTimer = 100
-    , _ptHitEff = hiteff
-    }
-  where 
-    setVel pt = pt & ptVel .+.+~ acc
-
-turnBulAt 
-    :: Maybe Int -- ^ Pass-through creature id
-    -> Color 
-    -> Point2   -- ^ Start position
-    -> Point2  -- ^ Velocity
-    -> Point2   -- ^ Acceleration
-    -> HitEffect 
-    -> Float    -- ^ Bullet width
-    -> Point2   -- ^ Target position
-    -> Particle
-turnBulAt maycid col pos vel acc hiteff width tpos = BulletPt
-    { _ptDraw = drawBul
-    , _ptUpdate = \w -> mvBullet w . setVel
-    , _ptVel  = vel
-    , _btDrag = 1
-    , _ptColor = col
-    , _ptTrail = [pos]
-    , _ptCrIgnore = maycid
-    , _ptWidth = width
-    , _ptTimer = 100
-    , _ptHitEff = hiteff
-    }
-  where 
-    setVel pt = pt & ptVel %~ vecTurnTo 0.1 (head $ _ptTrail pt) tpos
+    theupdate = case vfact of
+        Just _  -> \w -> resetVel . mvBullet w . updatemod
+        Nothing -> \w -> mvBullet w . updatemod
+    resetVel = second $ fmap $ (ptUpdate .~ (\w -> mvBullet w . updatemod)) . (ptVel .~ vel)