Refactor bullet particles

src/Dodge/Item/Weapon.hs

@@ -11,7 +11,8 @@ import Dodge.RandomHelp
 import Dodge.WorldEvent
 import Dodge.Default
 import Dodge.Item.Draw
-import Dodge.Item.Weapon.Bullet
+import Dodge.Particle.Bullet.HitEffect
+import Dodge.Particle.Bullet.Spawn
 --import Dodge.Item.Weapon.Decoration
 import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Item.Weapon.TriggerType
@@ -44,7 +45,6 @@ pistol
     ,lasGun
     ,tractorGun
     ,launcher
-    ,autoGun
     ,ltAutoGun
     ,hvAutoGun
     ,miniGun
@@ -78,7 +78,7 @@ pistol = Weapon
         . withRandomDir 0.1
         . withMuzFlare
         . withVelWthHiteff (30,0) 2 
-        $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
+        $ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
     , _wpSpread = 0.02
     , _wpRange = 20
     , _itHammer = HammerUp
@@ -114,7 +114,7 @@ autoEffectGun name eff = defaultAutoGun
     { _itName = name ++ "Gun"
     , _wpFire = eff
     }
-
+autoGun :: Item
 autoGun = defaultGun 
     { _itName = "AUTOGUN"
     , _itIdentity = AutoGun
@@ -153,7 +153,7 @@ autoGunNonTwistEff = withRecoil 40
     . withRandomDir (autogunSpread/2)
     . withMuzFlare
     . withVelWthHiteff (50,0) 3 
-    $ destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
+    $ destroyOnImpact bulHitCr bulHitWall' bulHitFF'
 
 rezGun = defaultGun
     { _itName = "REANIMATOR"
@@ -356,7 +356,7 @@ shootBezier targetp cid w = over particles (theBullet :) w
         startp 
         (controlp +.+ randPos) 
         (targetp +.+ randPos')
-        (destroyOnImpact bulHitCr' bulHitWall' bulHitFF') 
+        (destroyOnImpact bulHitCr bulHitWall' bulHitFF') 
         5
     controlp = mouseWorldPos w
     cr = _creatures w IM.! cid

src/Dodge/Item/Weapon/Bullet.hs

@@ -1,252 +0,0 @@
-{- |
-Effects of bullets upon impact with walls or creatures, and possibly force fields.
- -}
-module Dodge.Item.Weapon.Bullet
-    where
-import Dodge.Data
---import Dodge.Base
-import Dodge.WorldEvent
-import Dodge.WorldEvent.DamageBlock
-import Dodge.SoundLogic
-import Dodge.RandomHelp
-import Dodge.WorldEvent.Shockwave
-import Dodge.Creature.State.Data
-import Dodge.Creature.Property
-import Geometry
-import Picture
-
-import System.Random
-import Control.Lens
-import Control.Monad.State
---import Data.Maybe
---import qualified Data.IntMap.Strict as IM
--- | Basic bullet hit creature effect.
-bulHitCr' :: Particle -> Point2 -> Creature -> World -> World
-bulHitCr' bt p cr w 
-    | crIsArmouredFrom p cr
-        = createSpark 8 colID p1 (argV (p1 -.- p) + d1) Nothing . addDamageArmoured $ w
-    | otherwise = addDamage . makeHitSound . flashEff $ w
-  where
-    sp = head $ _btTrail' bt
-    bulVel = _btVel' bt
-    ep = sp +.+ bulVel
-    mvDams = [ PushDam 1 $ 2 *.* bulVel ]
-    addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
-    addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
-    makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
-    flashEff = over worldEvents (bloodFlashAt p . )
-    cid = _crID cr
-    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
-    (colID,_) = randomR (0,11) $ _randGen w
-    p1 = p +.+ 2 *.* safeNormalizeV (p -.- _crPos cr)
-{- | Bounce off armoured creatures, otherwise do damage.  -}
-bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World
-bulBounceArmCr' bt p cr w 
-    | crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w
-    | otherwise = addDamage . makeHitSound . flashEff $ w
-  where
-    sp = head $ _btTrail' bt
-    bulVel = _btVel' bt
-    ep = sp +.+ bulVel
-    mvDams = [ PushDam 1 $ 2 *.* bulVel ]
-    addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ )
-    addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++)
-    makeHitSound = soundMultiFrom [CrHitSound 0] 15 10 0
-    flashEff = over worldEvents ((.) $ bloodFlashAt p)
-    cid = _crID cr
-    newDir = safeNormalizeV (p -.- _crPos cr)
-    pOut = p +.+ 2 *.* newDir
-    reflectVel = magV bulVel *.* newDir
-    addBouncer = worldEvents %~ ( over particles (bouncer :) . )
-    bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel 
-                                      (_btHitEffect' bt) (_btWidth' bt)
-              ) {_btTimer' = _btTimer' bt - 1}
-{- | Bullet pass through creatures.  -}
-bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
-bulPenCr' bt p cr w 
-    = over (creatures . ix cid . crState . crDamage)
-           ([Piercing 50 sp p ep
-            ,Blunt    50  sp p ep
-            ,TorqueDam 1 d1
-            ,PushDam 1 $ 3 *.* (ep -.- sp)
-            ] 
-            ++
-           )
-    $ soundMultiFrom [CrHitSound 0] 15 10 0
-    $ over worldEvents (addPiercer . )
-    w
-  where 
-    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
-    cid = _crID cr
-    sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
-    addPiercer = over particles (piercer :)
-    piercer = (aGenBulAt' (Just cid) (_btColor' bt) p (_btVel' bt) 
-                                      (_btHitEffect' bt) (_btWidth' bt)
-              ) {_btTimer' = _btTimer' bt - 1}
-{- | Heavy bullet effects when hitting creature:
-piercing, blunt, twisting and pushback damage all applied.  -}
-hvBulHitCr' :: Particle -> Point2 -> Creature -> World -> World
-hvBulHitCr' bt p cr w 
-    = over (creatures . ix cid . crState . crDamage)
-           ([Piercing 200 sp p ep
-            ,Blunt    100  sp p ep
-            ,TorqueDam 1 d1
-            ,PushDam 1 $ 3 *.* (ep -.- sp)
-            ] 
-            ++
-           )
-    $ soundMultiFrom [CrHitSound 0] 15 10 0
-    w
-  where 
-    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
-    cid = _crID cr
-    sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
-{- | Create a flamelet when hitting a creature.  -}
-bulIncCr' :: Particle -> Point2 -> Creature -> World -> World
-bulIncCr' bt p cr w 
-    = over (creatures . ix cid . crState . crDamage)
-           ( Piercing 60 sp p ep : )
-    $ soundMultiFrom [CrHitSound 0] 15 10 0
-    $ incFlamelets
-    w
-  where   
-    cid = _crID cr
-    sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
-    v = evalState (randInCirc 1) $ _randGen w
-    incFlamelets = over worldEvents $ (.) (makeFlameletTimed p v Nothing 3 20)
-{- | Creates a shockwave when hitting a creature.  -}
-bulConCr' :: Particle -> Point2 -> Creature -> World -> World
-bulConCr' bt p cr w 
-    = over (creatures . ix cid . crState . crDamage)
-           ( Piercing 60 sp p ep : )
-    $ soundMultiFrom [CrHitSound 0] 15 10 0
-    $ mkwave
-    w
-  where   
-    cid = _crID cr
-    sp = head $ _btTrail' bt
-    ep = sp +.+ _btVel' bt
-    mkwave = over worldEvents $ (.) (makeShockwaveAt [] p 15 4 1 white)
-
-{- | Hitting wall effects: create a spark, damage blocks.  -}
-bulHitWall' :: Particle -> Point2 -> Wall -> World -> World
-bulHitWall' bt p x w = damageBlocksBy 5 x
-    $ createSpark 8 12 pOut (reflectDir x) Nothing
-    $ set randGen g
-    w
-  where 
-    sp = head $ _btTrail' bt
-    pOut = p +.+ safeNormalizeV (sp -.- p)
-    (a, g) = randomR (-0.2,0.2) $ _randGen w
-    reflectDir wall = a + argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
-{- | Bounce off walls, do damage to blocks.  -}
-bulBounceWall' :: Particle -> Point2 -> Wall -> World -> World
-bulBounceWall' bt p wl w = damageBlocksBy 5 wl $ over worldEvents addBouncer w
-  where 
-    sp = head $ _btTrail' bt
-    pOut = p +.+ safeNormalizeV (sp -.- p)
-    bouncer = (aGenBulAt' Nothing (_btColor' bt) pOut reflectVel 
-                                      (_btHitEffect' bt) (_btWidth' bt)
-              ) {_btTimer' = _btTimer' bt - 1}
-    wallV = uncurry (-.-) (_wlLine wl)
-    reflectVel = reflectIn wallV (_btVel' bt)
-    addBouncer = ( over particles (bouncer : ) . )
--- the hack is to get around the fact that the particles list gets reset after
--- all projectiles in it are checked, so we cannot add to it as we accumulate over
--- this list
-
-{- | Create flamelet on wall.  -}
-bulIncWall'
-    :: Particle 
-    -> Point2   -- Impact point
-    -> Wall 
-    -> World 
-    -> World
-bulIncWall' bt p wl w =  damageBlocksBy 5 wl $ incFlamelets w
-  where   
-    sp = head $ _btTrail' bt
-    pOut = p +.+ safeNormalizeV (sp -.- p)
-    wallV = uncurry (-.-) (_wlLine wl)
-    reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
-    incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut reflectVel Nothing 3 20)
-{- | Create a shockwave on wall-}
-bulConWall'
-    :: Particle 
-    -> Point2   -- ^ Impact point
-    -> Wall 
-    -> World 
-    -> World
-bulConWall' _ p wl = damageBlocksBy 1 wl . 
-    over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) 
-
-hvBulHitWall' 
-    :: Particle 
-    -> Point2   -- ^ Impact point
-    -> Wall 
-    -> World 
-    -> World
-hvBulHitWall' bt p x w =  damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv)
-  where 
-    sp = head $ _btTrail' bt
-    pOut = p +.+ safeNormalizeV (sp -.- p)
-    (a, g) = randomR (-0.2,0.2) $ _randGen w
-    reflectDir wall = a + 
-        argV (reflectIn (uncurry (-.-) (_wlLine wall)) (p -.- sp) )
-    sv = unitVectorAtAngle $ reflectDir x
-    cs      = take 10 $ randomRs (0,11) $ _randGen w
-    ds      = randomRs (-0.7,0.7) $ _randGen w
-    ts      = randomRs (4,8) $ _randGen w
-    sparks pos vel = zipWith3 (\t c d -> createSpark t c pos (argV vel + d) Nothing) ts cs ds
-
-bulHitFF' :: Particle -> Point2 -> ForceField -> World -> World
-bulHitFF' _ _ _ = id
-{- | Typical effect: destroy on impact, damage creatures and blocks, create spark on walls.  -}
-basicBulletEffect :: HitEffect
-basicBulletEffect = destroyOnImpact bulHitCr' bulHitWall' bulHitFF'
-
-aGenBulAt'
-    :: Maybe Int -- ^ Pass-through creature id
-    -> Color    
-    -> Point2   -- ^ Start position
-     -> Point2  -- ^ Velocity
-    -> HitEffect 
-    -> Float    -- ^ Bullet width
-    -> Particle
-aGenBulAt' maycid col pos vel hiteff width = Bul'
-    { _ptDraw = drawBul
-    , _ptUpdate' = mvGenBullet'
-    , _btVel' = vel
-    , _btColor' = col
-    , _btTrail' = [pos]
-    , _btPassThrough' = maycid
-    , _btWidth' = width
-    , _btTimer' = 100
-    , _btHitEffect' = hiteff
-    }
-
-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 = Bul'
-    { _ptDraw = drawBul
-    , _ptUpdate' = \w -> mvGenBullet' w . setVel
-    , _btVel' = (0,0)
-    , _btColor' = col
-    , _btTrail' = [pos]
-    , _btPassThrough' = maycid
-    , _btWidth' = width
-    , _btTimer' = 100
-    , _btHitEffect' = hiteff
-    }
-  where 
-    setVel pt = pt & btVel' .~ bf (fromIntegral $ _btTimer' pt - 1) -.- bf (fromIntegral $ _btTimer' pt)
-    bf t = bQuadToF (pos,control,targ) $ (100 - t) * 0.05

src/Dodge/Item/Weapon/TriggerType.hs

@@ -4,11 +4,11 @@ module Dodge.Item.Weapon.TriggerType
     where
 import Dodge.Data
 import Dodge.SoundLogic
-import Dodge.Creature.Action (reloadWeapon)
+import Dodge.Creature.Action (startReloadingWeapon)
 import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt)
 import Dodge.WorldEvent.Cloud
 import Dodge.RandomHelp
-import Dodge.Item.Weapon.Bullet
+import Dodge.Particle.Bullet.Spawn
 import Dodge.Item.Attachment.Data
 import Geometry
 
@@ -64,7 +64,7 @@ rateIncAB startRate fastRate shooteff1 shooteff2 cid w
                     $ set (pointItem . itUseTime) startRate
                     $ shooteff1 cid
                     w
-    | reloadCondition = fromMaybe w $ reloadWeapon cid w
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cid w
     | otherwise = w
   where 
     cr = _creatures w IM.! cid
@@ -90,7 +90,7 @@ withWarmUp
     -> World 
     -> World
 withWarmUp t f cid w 
-    | reloadCondition = fromMaybe w $ reloadWeapon cid w
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cid w
     | _wpReloadState item /= 0 = w
     | fState == 0 = set (pointerToItem . wpFire) (withWarmUp 100 f) 
                                     $ set (pointerToItem . itUseTime) 2 
@@ -175,7 +175,7 @@ shootWithSound soundid f cid w
         $ soundOncePos soundid (_crPos cr)
         $ set (pointerToItem . itUseTime) (_itUseRate item)
         $ f cid w
-    | reloadCondition = fromMaybe w $ reloadWeapon cid w
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cid w
     | otherwise = w
   where 
     cr  = _creatures w IM.! cid
@@ -226,7 +226,7 @@ shoot f cid w
     | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> ammo-1) 
                           $ set (pointerToItem . itUseTime) (_itUseRate item)
                           $ f cid w
-    | reloadCondition = fromMaybe w $ reloadWeapon cid w
+    | reloadCondition = fromMaybe w $ startReloadingWeapon cid w
     | otherwise = w
   where 
     cr  = _creatures w IM.! cid
@@ -276,7 +276,7 @@ withVelWthHiteff vel width hiteff cid w
     = over particles (newbul : ) $ set randGen g w
   where 
     cr = _creatures w IM.! cid
-    newbul = aGenBulAt' (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
+    newbul = aGenBulAt (Just cid) (numColor colid) pos (rotateV dir vel) hiteff width
     (colid, g) = randomR (0,11) $ _randGen w
     dir = _crDir cr
     pos = _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr)
@@ -363,7 +363,7 @@ spreadNumVelWthHiteff spread num vel wth eff cid w = over particles (newbuls ++)
   where 
     cr = _creatures w IM.! cid
     newbuls = zipWith3 
-        (\pos d colid -> aGenBulAt' (Just cid) (numColor colid) pos (rotateV d vel) eff wth) 
+        (\pos d colid -> aGenBulAt (Just cid) (numColor colid) pos (rotateV d vel) eff wth) 
         poss dirs colids
     poss = map ((+.+) $ _crPos cr +.+ _crRad cr *.* unitVectorAtAngle (_crDir cr))
         $ (replicateM num . randInCirc) 5 & evalState $ _randGen w
@@ -385,7 +385,7 @@ numVelWthHitEff num vel wth eff cid w = over particles (newbuls ++) w
   where 
     cr = _creatures w IM.! cid
     newbuls = zipWith 
-        (\p colid -> aGenBulAt' (Just cid) (numColor colid) p (rotateV d vel) eff wth) 
+        (\p colid -> aGenBulAt (Just cid) (numColor colid) p (rotateV d vel) eff wth) 
         poss 
         colids
     d = _crDir cr