Move bullets into own data type

src/Dodge/Combine/Module.hs

@@ -20,10 +20,10 @@ moduleModification imt = case imt of
     DRUMMAG     -> itConsumption . laMax .~ 45
     BELTMAG     -> itConsumption . laMax .~ 150
     MAGNETMAG   -> itUse . useDelay . rateMax .~ 4
-    INCENDBUL   -> f $ expireAndDamage $ spawnAtBulDams incBall
+    INCENDBUL   -> f $ expireAndDamage' $ spawnAtBulDams incBall
-    BOUNCEBUL   -> f $ expireAndDamage bounceBulDams
+    BOUNCEBUL   -> f $ expireAndDamage' bounceBulDams
-    STATICBUL   -> f $ expireAndDamage $ spawnAtBulDams aStaticBall
+    STATICBUL   -> f $ expireAndDamage' $ spawnAtBulDams aStaticBall
-    CONCUSBUL   -> f $ expireAndDamage $ spawnAtBulDams concBall
+    CONCUSBUL   -> f $ expireAndDamage' $ spawnAtBulDams concBall
     TARGCR      -> itTargeting .~ targetRBCreature
     TARGLAS     -> itTargeting .~ targetLaser
     TARGPOS     -> itTargeting .~ targetRBPress

src/Dodge/Creature/Damage.hs

@@ -42,20 +42,24 @@ applyDamageEffect dm de cr w = case de of
         & creatures . ix (_crID cr) . crPos .+.+~ (1/_crMass cr) *.* pback
     TorqueDamage rot -> w
         & creatures . ix (_crID cr) . crDir +~ rot
-    BounceBullet bt | crIsArmouredFrom p cr -> w & instantParticles .:~ bouncer
+    BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
       where
-        bouncer = (aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt)
+        bouncer = (aBulAt Nothing id (Just (_buColor bt)) pOut reflectVel (_buDrag bt)
-                                          (_ptHitEff bt) (_ptWidth bt)
+                                          (_buHitEff bt) (_buWidth bt)
-                  ) {_ptTimer = _ptTimer bt - 1}
+                  ) {_buTimer = _buTimer bt - 1}
         pOut = p +.+ 2 *.* newDir
         reflectVel = magV bulVel *.* newDir
         newDir = squashNormalizeV (p -.- _crPos cr)
-        bulVel = _ptVel bt
+        bulVel = _buVel bt
     BounceBullet _ -> w
     DamageSpawn f -> w & instantParticles .:~ thepart
         & randGen .~ g
       where
         (thepart,g) = runState (f (Left cr) dm) $ _randGen w
+    DamageSpawn' f -> w & instantBullets .:~ thepart
+        & randGen .~ g
+      where
+        (thepart,g) = runState (f (Left cr) dm) $ _randGen w
     NoDamageEffect -> w
   where
     fromDir = _dmFrom dm

src/Dodge/Data.hs

@@ -141,6 +141,8 @@ data World = World
     , _gusts                :: IM.IntMap Gust
     , _gsZoning             :: Zoning IM.IntMap Gust
     , _props                :: IM.IntMap Prop
+    , _instantBullets       :: [Bullet]
+    , _bullets              :: [Bullet]
     , _instantParticles     :: [Particle]
     , _particles            :: [Particle]
     , _radarBlips           :: [RadarBlip]
@@ -229,7 +231,7 @@ data Magnet = Magnet
     { _mgID :: Int
     , _mgUpdate :: Magnet -> Maybe Magnet
     , _mgPos :: Point2
-    , _mgField  :: Magnet -> Particle -> Particle
+    , _mgField  :: Magnet -> Bullet -> Bullet
     }
 
 data OptionScreenFlag = NormalOptions | GameOverOptions
@@ -522,6 +524,17 @@ data BeamType
         {_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
     | BeamSimple
 
+data Bullet = Bullet
+    { _buUpdate :: World -> Bullet -> (World, Maybe Bullet)
+    , _buVel    :: Point2
+    , _buDrag   :: Float
+    , _buColor  :: Color
+    , _buTrail  :: [Point2]
+    , _buWidth  :: Float 
+    , _buTimer  :: Int
+    , _buHitEff :: HitEffect'
+    }
+
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
 data Particle
@@ -540,6 +553,16 @@ data Particle
         , _ptPhaseV :: Float
         , _ptPoints :: [Point2]
         }
+    | PtSpark
+        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
+        , _ptVel    :: Point2
+        , _ptDrag   :: Float
+        , _ptColor  :: Color
+        , _ptTrail  :: [Point2]
+        , _ptWidth  :: Float 
+        , _ptTimer  :: Int
+        , _ptHitEff :: HitEffect
+        }
     | PtTeslaArc 
         { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptPoints :: [Point2]
@@ -551,16 +574,6 @@ data Particle
         , _ptPoints :: [Point2]
         , _ptColor  :: Color
         }
-    | BulletPt
-        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptVel    :: Point2
-        , _btDrag   :: Float
-        , _ptColor  :: Color
-        , _ptTrail  :: [Point2]
-        , _ptWidth  :: Float 
-        , _ptTimer  :: Int
-        , _ptHitEff :: HitEffect
-        }
     | PtFlame  
         { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptVel    :: Point2
@@ -625,6 +638,11 @@ type HitEffect = Particle
     -> World 
     -> (World,Maybe Particle)
 
+type HitEffect' = Bullet 
+    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+    -> World 
+    -> (World,Maybe Bullet)
+
 data BulletTrajectory
     = BasicBulletTrajectory
     | BezierTrajectory
@@ -641,7 +659,7 @@ data AmmoType
         }
     | BulletAmmo
         { _amString :: String 
-        , _amBulEff :: HitEffect
+        , _amBulEff :: HitEffect'
         , _amBulWth :: Float
         , _amBulVel :: Point2
         , _amBulTraj :: BulletTrajectory
@@ -1230,9 +1248,11 @@ data DamageEffect
         }
     | TorqueDamage { _deTorque :: Float }
     | PushBackDamage {_dePushBack :: Point2 }
-    | BounceBullet {_bulToBounce :: Particle}
+    | BounceBullet {_bulToBounce :: Bullet}
     | DamageSpawn {_spawnFunc 
         :: Either Creature Wall -> Damage -> State StdGen Particle}
+    | DamageSpawn' {_spawnFunc' 
+        :: Either Creature Wall -> Damage -> State StdGen Bullet}
     | NoDamageEffect
 --  deriving (Eq,Ord,Show)
 
@@ -1388,6 +1408,7 @@ makeLenses ''TweakParam
 makeLenses ''Prop
 makeLenses ''Modification
 makeLenses ''Particle
+makeLenses ''Bullet
 makeLenses ''PressPlate
 makeLenses ''Button
 makeLenses ''ActionPlan

src/Dodge/Default/World.hs

@@ -39,6 +39,8 @@ defaultWorld = World
     , _gsZoning         = Zoning IM.empty clZoneSize (zonePos _guPos)
     , _itemPositions = IM.empty
     , _props = IM.empty
+    , _instantBullets = []
+    , _bullets = []
     , _instantParticles = []
     , _particles = []
     , _radarBlips = []

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -15,7 +15,7 @@ import Data.Maybe
 --import Control.Lens
 
 useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
-useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt 
+useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt 
     vfact 
     thetraj                     -- extra update
     Nothing                     -- color (default)
@@ -34,15 +34,15 @@ useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt
         BasicBulletTrajectory -> id
         MagnetTrajectory -> fromMaybe id $ do
             tpos <- it ^? itTargeting . tgPos . _Just
-            return $ \pt -> pt & ptVel .+.+~ 5 *.* normalizeV (tpos -.- head (_ptTrail pt))
+            return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- head (_buTrail pt))
         FlechetteTrajectory -> fromMaybe id $ do
             tpos <- it ^? itTargeting . tgPos . _Just
-            return $ \pt -> pt & ptVel %~ vecTurnTo 0.2 (head $ _ptTrail pt) tpos
+            return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (head $ _buTrail pt) tpos
         BezierTrajectory -> fromMaybe id $ do
             tpos <- it ^? itTargeting . tgPos . _Just
             let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05
             return $ \pt -> pt 
-                & ptVel .~ bf (fromIntegral $ _ptTimer pt - 1) -.- bf (fromIntegral $ _ptTimer pt)
+                & buVel .~ bf (fromIntegral $ _buTimer pt - 1) -.- bf (fromIntegral $ _buTimer pt)
 
 ---- this shouldn't really be used
 loadedAmmo :: Item -> Int

src/Dodge/Item/Weapon/Bullet.hs

@@ -10,7 +10,7 @@ import Geometry.Data
 basicBullet :: AmmoType
 basicBullet = BulletAmmo
     { _amString = "BASIC"
-    , _amBulEff = expireAndDamage basicBulDams
+    , _amBulEff = expireAndDamage' basicBulDams
     , _amBulWth = 2
     , _amBulVel = V2 50 0
     , _amBulTraj = BasicBulletTrajectory
@@ -18,7 +18,7 @@ basicBullet = BulletAmmo
 hvBullet :: AmmoType
 hvBullet = BulletAmmo
     { _amString = "HVBULLET"
-    , _amBulEff = expireAndDamage hvBulDams
+    , _amBulEff = expireAndDamage' hvBulDams
     , _amBulWth = 6
     , _amBulVel = V2 80 0
     , _amBulTraj = BasicBulletTrajectory

src/Dodge/Item/Weapon/BulletGun/Rod.hs

@@ -63,7 +63,7 @@ bangRod = defaultBulletWeapon
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
     & itUse . useAim . aimHandlePos .~ 5
     & itUse . useAim . aimMuzPos .~ 30
-    & itConsumption . laAmmoType . amBulEff .~ expireAndDamage heavyBulDams
+    & itConsumption . laAmmoType . amBulEff .~ expireAndDamage' heavyBulDams
 elephantGun :: Item
 elephantGun = bangRod
     & itType . iyBase .~ HELD ELEPHANTGUN

src/Dodge/Magnet.hs

@@ -4,23 +4,23 @@ import Geometry
 
 import Control.Lens
 
-dampField :: Magnet -> Particle -> Particle
+dampField :: Magnet -> Bullet -> Bullet
 dampField mg pt = case pt of
-    BulletPt{} | dist (head $ _ptTrail pt) (_mgPos mg) < 100 -> pt & ptVel *~ 0.5
+    Bullet{} | dist (head $ _buTrail pt) (_mgPos mg) < 100 -> pt & buVel *~ 0.5
     _ -> pt
 
-curveLeftField :: Magnet -> Particle -> Particle
+curveLeftField :: Magnet -> Bullet -> Bullet
 curveLeftField mg pt = case pt of
-    BulletPt{} | dist (head $ _ptTrail pt) (_mgPos mg) < 500 -> pt & ptVel %~ rotateV 0.2
+    Bullet{} | dist (head $ _buTrail pt) (_mgPos mg) < 500 -> pt & buVel %~ rotateV 0.2
     _ -> pt
 
-curveAroundField :: Float -> Float -> Magnet -> Particle -> Particle
+curveAroundField :: Float -> Float -> Magnet -> Bullet -> Bullet
 curveAroundField minrad maxrad mg pt = case pt of
-    BulletPt{} | thedist < maxrad -> pt & ptVel %~ rotateToCircle
+    Bullet{} | thedist < maxrad -> pt & buVel %~ rotateToCircle
       where
         thedist = dist btpos mgpos
         mgpos = _mgPos mg
-        btpos = head $ _ptTrail pt
+        btpos = head $ _buTrail pt
         rotateToCircle vel 
             | (isLHS mgpos btpos (btpos +.+ vel) && isRHS mgpos btpos (mgpos +.+ vNormal vel) )
               || (isRHS mgpos btpos (btpos +.+ vel) && isLHS mgpos btpos (mgpos +.+ vNormal vel) )

src/Dodge/Particle/Bullet/Draw.hs

@@ -4,9 +4,9 @@ module Dodge.Particle.Bullet.Draw
 import Dodge.Data
 import Picture
 
-drawBul :: Particle -> Picture
+drawBul :: Bullet -> Picture
 drawBul pt = setLayer BloomNoZWrite
     . setDepth 20 
-    . color (_ptColor pt) 
+    . color (_buColor pt) 
     -- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
-    $ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt)
+    $ thickLine (_buWidth pt) (take 2 $ _buTrail pt)

src/Dodge/Particle/Bullet/Spawn.hs

@@ -12,27 +12,26 @@ import Data.Bifunctor
 
 aBulAt
     :: Maybe Float    -- ^ Start velocity step factor
-    -> (Particle -> Particle)
+    -> (Bullet -> Bullet)
     -> Maybe Color
     -> Point2   -- ^ Start position
     -> Point2  -- ^ Velocity
     -> Float    -- ^ Drag
-    -> HitEffect 
+    -> HitEffect' 
     -> Float    -- ^ Bullet width
-    -> Particle
+    -> Bullet
-aBulAt vfact updatemod mcol pos vel drag hiteff width = BulletPt
+aBulAt vfact updatemod mcol pos vel drag hiteff width = Bullet
-    { _ptUpdate = theupdate
+    { _buUpdate = theupdate
-    , _ptVel  = fromMaybe 1 vfact *.* vel
+    , _buVel  = fromMaybe 1 vfact *.* vel
-    , _btDrag = drag
+    , _buDrag = drag
-    , _ptColor = fromMaybe (V4 200 200 200 2) mcol
+    , _buColor = fromMaybe (V4 200 200 200 2) mcol
---    , _ptColor = V4 2 2 2 2
+    , _buTrail = [pos]
-    , _ptTrail = [pos]
+    , _buWidth = width
-    , _ptWidth = width
+    , _buTimer = 100
-    , _ptTimer = 100
+    , _buHitEff = hiteff
-    , _ptHitEff = hiteff
     }
   where
     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)
+    resetVel = second $ fmap $ (buUpdate .~ (\w -> mvBullet w . updatemod)) . (buVel .~ vel)

src/Dodge/Particle/Bullet/Update.hs

@@ -2,6 +2,7 @@
 {- Bullet update.  -}
 module Dodge.Particle.Bullet.Update
     ( mvBullet
+    , mvSpark
     ) where
 import Dodge.Data
 --import Dodge.Base
@@ -12,15 +13,29 @@ import LensHelp
 
 import Data.Bifunctor
 {- Update for a generic bullet.  -}
-mvBullet :: World -> Particle -> (World, Maybe Particle)
+mvBullet :: World -> Bullet -> (World, Maybe Bullet)
 mvBullet w bt' 
-    | t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
+    | 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
+    drag = _buDrag bt
+    (p:_)   = _buTrail bt
+    vel     = _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 = _btDrag bt
+    drag = _ptDrag bt
     (p:_)   = _ptTrail bt
     vel     = _ptVel bt
     hiteff  = _ptHitEff bt

src/Dodge/Particle/Damage.hs

@@ -8,43 +8,49 @@ import Control.Monad.State
 
 -- TODO unify particle position in a sensible manner
 spawnAtBulDams :: (Point2 -> State StdGen Particle)
-    -> Particle -> Point2 -> [Damage]
+    -> Bullet -> Point2 -> [Damage]
 spawnAtBulDams thespawn bt p =
     [ Damage PIERCING 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm))
     , Damage PUSHDAM   1 sp p ep . PushBackDamage $ 2 *.* bulVel
     ]
   where
-    sp = head $ _ptTrail bt
+    sp = head $ _buTrail bt
-    bulVel = _ptVel bt
+    bulVel = _buVel bt
     ep = sp +.+ bulVel
 
 simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
 simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
   where
-    sp = case bt ^? ptTrail of
+    sp = _ptPos bt
-        Nothing -> _ptPos bt
-        Just xs -> head xs
     bulVel = _ptVel bt
     ep = sp +.+ bulVel
+simpleDam' :: DamageType -> Int -> Bullet -> Point2 -> [Damage]
+simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
+  where
+    sp = case bt ^? buTrail of
+        Nothing -> 0
+        Just xs -> head xs
+    bulVel = _buVel bt
+    ep = sp +.+ bulVel
 
-heavyBulDams :: Particle -> Point2 -> [Damage]
+heavyBulDams :: Bullet -> Point2 -> [Damage]
 heavyBulDams bt p =
     [ Damage PIERCING 300 sp p ep NoDamageEffect
     , Damage PUSHDAM    1 sp p ep . PushBackDamage $ 2 *.* bulVel
     ]
   where
-    sp = head $ _ptTrail bt
+    sp = head $ _buTrail bt
-    bulVel = _ptVel bt
+    bulVel = _buVel bt
     ep = sp +.+ bulVel
 
-basicBulDams :: Particle -> Point2 -> [Damage]
+basicBulDams :: Bullet -> Point2 -> [Damage]
 basicBulDams bt p =
     [ Damage PIERCING 100 sp p ep NoDamageEffect
     , Damage PUSHDAM    1 sp p ep . PushBackDamage $ 2 *.* bulVel
     ]
   where
-    sp = head $ _ptTrail bt
+    sp = head $ _buTrail bt
-    bulVel = _ptVel bt
+    bulVel = _buVel bt
     ep = sp +.+ bulVel
 
 basicSparkDams :: Particle -> Point2 -> [Damage]
@@ -54,7 +60,7 @@ basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
     bulVel = _ptVel bt
     ep = sp +.+ bulVel
 
-hvBulDams :: Particle -> Point2 -> [Damage]
+hvBulDams :: Bullet -> Point2 -> [Damage]
 hvBulDams bt p =
     [ Damage PIERCING  25 sp p ep NoDamageEffect
     , Damage PIERCING  25 sp p ep NoDamageEffect
@@ -66,16 +72,16 @@ hvBulDams bt p =
     , Damage PUSHDAM    1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
     ] 
   where
-    sp = head $ _ptTrail bt
+    sp = head $ _buTrail bt
-    bulVel = _ptVel bt
+    bulVel = _buVel bt
     ep = sp +.+ bulVel
 
-bounceBulDams :: Particle -> Point2 -> [Damage]
+bounceBulDams :: Bullet -> Point2 -> [Damage]
 bounceBulDams bt p =
     [ Damage PIERCING 80 sp p ep (BounceBullet bt)
     , Damage PUSHDAM   1 sp p ep . PushBackDamage $ 2 *.* bulVel
     ]
   where
-    sp = head $ _ptTrail bt
+    sp = head $ _buTrail bt
-    bulVel = _ptVel bt
+    bulVel = _buVel bt
     ep = sp +.+ bulVel

src/Dodge/Particle/Draw.hs

@@ -10,7 +10,7 @@ drawParticle pt = case pt of
     PtStaticBall {} -> drawStaticBall pt
     PtIncBall {} -> drawFlameletZ pt
     PtInvShockwave {} -> drawInverseShockwave pt
-    BulletPt {} -> drawBul pt
+    PtSpark {} -> drawSpark pt
     PtTeslaArc {} -> drawTeslaArc pt
     PtTargetLaser {} -> drawTargetLaser pt
     LaserParticle {} -> drawLaser pt
@@ -124,8 +124,15 @@ drawInverseShockwave  pt
     rad = r - 0.1 * r * fromIntegral (10 - t)
     thickness = fromIntegral (10 - t) **2 * rad / 40
 
-drawBul :: Particle -> Picture
+drawBul :: Bullet -> Picture
 drawBul pt = setLayer BloomNoZWrite
+    . setDepth 20 
+    . color (_buColor pt) 
+    -- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)
+    $ thickLine (_buWidth pt) (take 2 $ _buTrail pt)
+
+drawSpark :: Particle -> Picture
+drawSpark pt = setLayer BloomNoZWrite
     . setDepth 20 
     . color (_ptColor pt) 
     -- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt)

src/Dodge/Particle/HitEffect.hs

@@ -8,19 +8,20 @@ import Dodge.Particle.HitEffect.ExpireAndDamage
 import Geometry
 
 import Data.Bifunctor
-type HitCreatureEffect   = Particle -> Point2 -> Creature   -> World -> World
+
-type HitWallEffect       = Particle -> Point2 -> Wall       -> World -> World
+type HitCreatureEffect'   = Bullet -> Point2 -> Creature   -> World -> World
+type HitWallEffect'       = Bullet -> Point2 -> Wall       -> World -> World
 
 penWalls 
-    :: HitCreatureEffect 
+    :: HitCreatureEffect' 
-    -> HitWallEffect 
+    -> HitWallEffect' 
-    -> Particle 
+    -> Bullet 
     -> [(Point2, Either Creature Wall)] 
     -> World 
-    -> (World, Maybe Particle)
+    -> (World, Maybe Bullet)
 penWalls crEff wlEff pt hitThings w = case hitThings of
     []              -> (              w, mvPt pt)
-    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt p pt)
+    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
     ((p,Right wl):hs) | _wlFireThrough wl 
                     -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
-    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt p pt)
+    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)

src/Dodge/Particle/HitEffect/ExpireAndDamage.hs

@@ -14,9 +14,18 @@ expireAndDamage :: (Particle -> Point2 -> [Damage])
     -> World
     -> (World, Maybe Particle)
 expireAndDamage fdm bt things w = case runIdentity $ S.head_ things of
-    Nothing -> (w, mvPt bt)
+    Nothing -> (w, mvPt' bt)
     Just x -> (doDamages fdm x bt w, destroyAt (fst x) bt)
 
+expireAndDamage' :: (Bullet -> Point2 -> [Damage])
+    -> Bullet
+    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+    -> World
+    -> (World, Maybe Bullet)
+expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of
+    Nothing -> (w, mvPt bt)
+    Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt)
+
 doDamages :: (Particle -> Point2 -> [Damage])
     -> (Point2, Either Creature Wall)
     -> Particle
@@ -27,3 +36,14 @@ doDamages fdm (p,thhit) bt = case thhit of
     Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
   where
     dams = fdm bt p
+
+doDamages' :: (Bullet -> Point2 -> [Damage])
+    -> (Point2, Either Creature Wall)
+    -> Bullet
+    -> World
+    -> World
+doDamages' fdm (p,thhit) bt = case thhit of
+    Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams
+    Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
+  where
+    dams = fdm bt p

src/Dodge/Particle/HitEffect/Penetrate.hs

@@ -10,16 +10,16 @@ import Streaming
 import qualified Streaming.Prelude as S
 
 penetrate 
-    :: ((Point2,Either Creature Wall) -> Particle -> Maybe Particle) 
+    :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet) 
         -- | penetration test, can update particle if it penetrates
-    -> (Particle -> Point2 -> [Damage]) -- | damages when penetrating
+    -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
-    -> (Particle -> Point2 -> [Damage]) -- | damages when not penetrating
+    -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
-    -> Particle
+    -> Bullet
     -> Stream (Of (Point2, Either Creature Wall)) Identity ()
     -> World
-    -> (World, Maybe Particle)
+    -> (World, Maybe Bullet)
 penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
     Nothing -> (w, mvPt pt)
     Just (x,xs) -> case t x pt of
-        Nothing -> expireAndDamage stopdam pt hitThings w
+        Nothing -> expireAndDamage' stopdam pt hitThings w
-        Just pt' -> first (doDamages pendam x pt) $ penetrate t pendam stopdam pt' xs w
+        Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w

src/Dodge/Particle/Spark.hs

@@ -19,10 +19,10 @@ import System.Random
 --import Control.Lens
 -- TODO remove/simplify this function
 createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World
-createBarrelSpark pos dir time colid = instantParticles .:~ BulletPt  
+createBarrelSpark pos dir time colid = instantParticles .:~ PtSpark  
-    { _ptUpdate = mvBullet
+    { _ptUpdate = mvSpark
     , _ptVel = rotateV dir (V2 5 0)
-    , _btDrag = 0.9
+    , _ptDrag = 0.9
     , _ptColor = numColor colid
     , _ptTrail = [pos]
     , _ptWidth = 1
@@ -48,9 +48,9 @@ randColDirTimeSpark randcol randdir randtime pos w = w
         d <- randdir
         t <- randtime
         return (c,d,t)
-    spark = BulletPt
+    spark = PtSpark
-        { _ptUpdate = mvBullet
+        { _ptUpdate = mvSpark
-        , _btDrag   = 0.9
+        , _ptDrag   = 0.9
         , _ptVel    = rotateV dir (V2 5 0)
         , _ptColor  = col
         , _ptTrail  = [pos]
@@ -66,9 +66,9 @@ colSparkRandDir randDir time col pos baseDir w = w
   where
     (a,g)  = randomR (-randDir,randDir) $ _randGen w
     dir = a + baseDir
-    spark = BulletPt
+    spark = PtSpark
-        { _ptUpdate = mvBullet
+        { _ptUpdate = mvSpark
-        , _btDrag   = 0.9
+        , _ptDrag   = 0.9
         , _ptVel = rotateV dir (V2 5 0)
         , _ptColor = col
         , _ptTrail = [pos]

src/Dodge/Particle/Update.hs

@@ -3,8 +3,15 @@ import Dodge.Data
 import LensHelp
 import Geometry
 
-mvPt :: Particle -> Maybe Particle
+mvPt :: Bullet -> Maybe Bullet
 mvPt pt = Just $ pt
+    & buTrail %~ f
+    & buTimer -~ 1
+  where
+    f trl = head trl +.+ _buVel pt : trl
+
+mvPt' :: Particle -> Maybe Particle
+mvPt' pt = Just $ pt
     & ptTrail %~ f
     & ptTimer -~ 1
   where
@@ -12,12 +19,25 @@ mvPt pt = Just $ pt
 
 destroyAt :: Point2 -> Particle -> Maybe Particle
 destroyAt hitp pt = Just $ pt 
-    & ptUpdate .~ killBulletUpdate
+    & ptUpdate .~ killParticleUpdate
     & ptTrail  .:~ hitp
     & ptTimer %~ (min 3 . subtract 1)
+destroyAt' :: Point2 -> Bullet -> Maybe Bullet
+destroyAt' hitp pt = Just $ pt 
+    & buUpdate .~ killBulletUpdate
+    & buTrail  .:~ hitp
+    & buTimer %~ (min 3 . subtract 1)
 
-killBulletUpdate :: World -> Particle -> (World,Maybe Particle)
+killBulletUpdate :: World -> Bullet -> (World,Maybe Bullet)
 killBulletUpdate w pt 
+    | _buTimer pt <= 0 = (w,Nothing)
+    | otherwise = (w
+        , Just $ pt & buTimer -~ 1
+            & buTrail %~ (\(x:xs) -> x:x:xs)
+        )
+
+killParticleUpdate :: World -> Particle -> (World,Maybe Particle)
+killParticleUpdate w pt 
     | _ptTimer pt <= 0 = (w,Nothing)
     | otherwise = (w
         , Just $ pt & ptTimer -~ 1

src/Dodge/Render/ShapePicture.hs

@@ -84,6 +84,7 @@ cullPoint cfig w p
 extraPics :: Configuration -> World -> Picture
 extraPics cfig w = pictures (_decorations w)
     <> concatMapPic drawParticle (_particles    w)
+    <> concatMapPic drawBul (_bullets w)
     <> concatMapPic drawBlip (_radarBlips    w)
     <> concatMapPic drawFlare (_flares    w)
     <> concatMapPic (dbArg _bmDraw) (_positronBeams $ _beams w)

src/Dodge/Update.hs

@@ -81,6 +81,7 @@ functionalUpdate cfig w = checkEndGame
     . dbArg _worldEvents
     . updateIMl _modifications _mdUpdate
     . updateParticles 
+    . updateBullets 
     . updateRadarBlips 
     . updateFlares 
     . updateBeams
@@ -212,6 +213,12 @@ updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip
 updateFlares :: World -> World
 updateFlares = flares %~ mapMaybe updateFlare
 
+{- Apply internal particle updates, delete 'Nothing's.  -}
+updateBullets :: World -> World
+updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w'
+  where 
+    (w',ps) = mapAccumR (\a b -> _buUpdate b a b) w $ _bullets w
+
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World
 updateParticles w = updateInstantParticles $ set particles (catMaybes ps) w'
@@ -287,6 +294,11 @@ intersectSegSegs' _ _ _ = Nothing
 --    Just
 --    (intersectSegSegss x y ass)
 --intersectSegsSegss _ _ = Nothing
+updateInstantBullets :: World -> World
+updateInstantBullets w = case _instantBullets w of
+    [] -> w
+    ps -> let (w',ps') = mapAccumR (\a b -> _buUpdate b a b) (w {_instantBullets=[]}) ps
+        in updateInstantBullets $ w' & bullets .++~ catMaybes ps'
 
 updateInstantParticles :: World -> World
 updateInstantParticles w = case _instantParticles w of

src/Dodge/Wall/DamageEffect.hs

@@ -133,11 +133,11 @@ dirtWallDamage dm wl = case _dmType dm of
 
 wallDamageEffect :: Damage -> Wall -> World -> World
 wallDamageEffect dm wl w = case _dmEffect dm of
-    BounceBullet bt -> w & instantParticles .:~ thebouncer
+    BounceBullet bt -> w & instantBullets .:~ thebouncer
       where
-        reflectVel = reflVelWall wl (_ptVel bt)
+        reflectVel = reflVelWall wl (_buVel bt)
-        thebouncer = aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
+        thebouncer = aBulAt Nothing id (Just (_buColor bt)) pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt)
-            & ptTimer .~ _ptTimer bt - 1
+            & buTimer .~ _buTimer bt - 1
         pOut = p +.+ squashNormalizeV (sp -.- p)
         p = _dmAt dm
         sp = _dmFrom dm