Move bullet bouncing into separate datatype field

src/Dodge/Bullet.hs

@@ -1,15 +1,21 @@
 module Dodge.Bullet where
+import Dodge.Particle.Damage
+import Dodge.Creature.Test
 import Dodge.Data
+import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.Creature.HandPos
 import Dodge.Base.Coordinate
+import Dodge.Base.Wall
 import Geometry
 import LensHelp
+import StreamingHelp
 
+import qualified Streaming.Prelude as S
 import Data.Maybe
 import Dodge.Movement.Turn
 import Dodge.WorldEvent.ThingsHit
 
-import Data.Bifunctor
+--import Data.Bifunctor
 
 updateBullet :: World -> Bullet -> (World,Maybe Bullet)
 updateBullet w bu = case _buState bu of
@@ -22,12 +28,16 @@ aBulAt
     -> Point2   -- ^ Start position
     -> Point2  -- ^ Velocity
     -> Float    -- ^ Drag
-    -> HitEffect' 
+--    -> HitEffect' 
     -> Float    -- ^ Bullet width
     -> BulletTrajectory
+    -> BulletEffect
+    -> BulletSpawn
     -> Bullet
-aBulAt vfact pos vel drag hiteff width butraj = Bullet
+aBulAt vfact pos vel drag width butraj be bs = Bullet
     { _buState = bulstate
+    , _buSpawn = bs
+    , _buEffect = be
     , _buUpdateMod = NoBulletUpdateMod
     , _buTrajectory = butraj
     , _buVel  = vel
@@ -36,7 +46,6 @@ aBulAt vfact pos vel drag hiteff width butraj = Bullet
     , _buOldPos = pos
     , _buWidth = width
     , _buTimer = 100
-    , _buHitEff = hiteff
     }
   where
     bulstate = maybe NormalBulletState DelayedBullet vfact
@@ -47,9 +56,10 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
     sp
     (rotateV dir (muzvel *.* _amBulVel bultype))           -- vel
     (_rifling $ _itParams it)   -- drag
-    (_amBulEff bultype) 
     (_amBulWth bultype) 
     thetraj
+    (_amBulEffect bultype)
+    (_amBulSpawn bultype)
   where
     sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
     dir = _crDir cr
@@ -77,9 +87,31 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
 mvBullet :: World -> Bullet -> (World, Maybe Bullet)
 mvBullet w bt' 
     | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing)
-    | otherwise = second (fmap dodrag) $ 
+    | otherwise = bimap maybebounce (fmap dodrag) $ 
-        hiteff bt (thingsHit p (p +.+ vel) w) w
+        hiteff bt hitstream w
   where
+    maybebounce = case _buEffect bt' of
+        BounceBullet -> case runIdentity (S.head_ hitstream) of
+            Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
+              where
+                bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buWidth bt) 
+                            BasicBulletTrajectory (_buEffect bt) (_buSpawn bt)
+                          ) {_buTimer = _buTimer bt - 1}
+                pOut = hp +.+ 2 *.* newDir
+                reflectVel = magV bulVel *.* newDir
+                newDir = squashNormalizeV (hp -.- _crPos cr)
+                bulVel = _buVel bt
+            Just (hp, Right wl) -> instantBullets .:~ thebouncer
+              where
+                reflectVel = reflVelWall wl (_buVel bt)
+                thebouncer = aBulAt Nothing --id 
+                    pOut reflectVel (_buDrag bt) (_buWidth bt) BasicBulletTrajectory (_buEffect bt)
+                        (_buSpawn bt)
+                    & buTimer .~ _buTimer bt - 1
+                pOut = hp +.+ squashNormalizeV (p -.- hp)
+            _ -> id
+        _ -> id
+    hitstream = thingsHit p (p +.+ vel) w
     bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
     dodrag = case _buTrajectory bt of
         BasicBulletTrajectory -> buVel .*.*~ drag
@@ -91,8 +123,33 @@ mvBullet w bt'
     drag = _buDrag bt
     p       = _buPos bt
     vel     = _buVel bt
-    hiteff  = _buHitEff bt
+    hiteff  = hitEffFromBul
     t       = _buTimer bt
+    --BounceBullet bt -> w & instantBullets .:~ thebouncer
+    --  where
+    --    reflectVel = reflVelWall wl (_buVel bt)
+    --    thebouncer = aBulAt Nothing --id 
+    --        pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) BasicBulletTrajectory
+    --        & buTimer .~ _buTimer bt - 1
+    --    pOut = p +.+ squashNormalizeV (sp -.- p)
+    --    p = _dmAt dm
+    --    sp = _dmFrom dm
+--    BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
+--      where
+--        bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) 
+--                    BasicBulletTrajectory
+--                  ) {_buTimer = _buTimer bt - 1}
+--        pOut = p +.+ 2 *.* newDir
+--        reflectVel = magV bulVel *.* newDir
+--        newDir = squashNormalizeV (p -.- _crPos cr)
+--        bulVel = _buVel bt
+--    BounceBullet _ -> w
+
+hitEffFromBul :: Bullet
+    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+    -> World 
+    -> (World,Maybe Bullet)
+hitEffFromBul = expireAndDamage' basicBulDams
 
 mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet)
 mvBulletSlow x w bt' 
@@ -106,5 +163,5 @@ mvBulletSlow x w bt'
     drag = _buDrag bt
     p       = _buPos bt
     vel     = x *.* _buVel bt
-    hiteff  = _buHitEff bt
+    hiteff  = hitEffFromBul
     t       = _buTimer bt

src/Dodge/Combine/Module.hs

@@ -1,7 +1,6 @@
 module Dodge.Combine.Module where
 import Dodge.Data
 import Dodge.Tesla
-import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.Particle.Damage
 import Dodge.Item.Weapon.ExtraEffect
@@ -20,10 +19,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 $ spawnAtBulDams incBall
-    BOUNCEBUL   -> f $ expireAndDamage' bounceBulDams
+    BOUNCEBUL   -> itConsumption . laAmmoType . amBulEffect .~ BounceBullet 
-    STATICBUL   -> f $ expireAndDamage' $ spawnAtBulDams aStaticBall
+    STATICBUL   -> f $ spawnAtBulDams aStaticBall
-    CONCUSBUL   -> f $ expireAndDamage' $ spawnAtBulDams concBall
+    CONCUSBUL   -> f $ spawnAtBulDams concBall
     TARGCR      -> itTargeting .~ targetRBCreature
     TARGLAS     -> itTargeting .~ targetLaser
     TARGPOS     -> itTargeting .~ targetRBPress
@@ -40,7 +39,7 @@ moduleModification imt = case imt of
     EXTRABATTERY -> itConsumption . laMax +~ 1000
     ATTACHTORCH  -> id
   where
-    f ameff = itConsumption . laAmmoType . amBulEff .~ ameff
+    f ameff = itConsumption . laAmmoType . amBulDams .~ ameff
     makeDirectedTele it = it 
         & itTargeting .~ targetRBPress
         & itUse . useMods .:~ withPosDirWallCheck directedTelPos

src/Dodge/Creature.hs

@@ -236,6 +236,8 @@ inventoryX c = case c of
         , makeTypeCraftNum 1 LIGHTSENSOR
         , makeTypeCraftNum 1 SOUNDSENSOR
         , makeTypeCraftNum 1 HEATSENSOR
+        , makeTypeCraftNum 1 BOUNCEMODULE
+        , makeTypeCraftNum 1 INCENDIARYMODULE
         ]
     _ -> []
 

src/Dodge/Creature/Damage.hs

@@ -2,7 +2,7 @@ module Dodge.Creature.Damage where
 import Dodge.Data
 import Dodge.Creature.Test
 import Dodge.Spark
-import Dodge.Bullet
+--import Dodge.Bullet
 import Color
 import Geometry
 import LensHelp
@@ -42,16 +42,6 @@ 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 & instantBullets .:~ bouncer
-      where
-        bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) 
-                    BasicBulletTrajectory
-                  ) {_buTimer = _buTimer bt - 1}
-        pOut = p +.+ 2 *.* newDir
-        reflectVel = magV bulVel *.* newDir
-        newDir = squashNormalizeV (p -.- _crPos cr)
-        bulVel = _buVel bt
-    BounceBullet _ -> w
     DamageSpawn f -> w & instantParticles .:~ thepart
         & randGen .~ g
       where
@@ -63,7 +53,7 @@ applyDamageEffect dm de cr w = case de of
     NoDamageEffect -> w
   where
     fromDir = _dmFrom dm
-    p = _dmAt dm
+    --p = _dmAt dm
 
 applyIndividualDamage :: Creature -> World -> Damage -> World
 applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIndividualDamage' cr w dm

src/Dodge/Data.hs

@@ -529,8 +529,15 @@ data BulletState = NormalBulletState
     | DelayedBullet Float
 data BulletUpdateMod = NoBulletUpdateMod
 
+data BulletEffect = DestroyBullet
+    | BounceBullet
+    | PenetrateBullet
+data BulletSpawn = BulBall EnergyBall | BulSpark
+
 data Bullet = Bullet
     { _buState  :: BulletState
+    , _buEffect :: BulletEffect
+    , _buSpawn  :: BulletSpawn
     , _buUpdateMod :: BulletUpdateMod
     , _buTrajectory :: BulletTrajectory
     , _buVel    :: Point2
@@ -540,11 +547,8 @@ data Bullet = Bullet
     , _buWidth  :: Float 
     , _buTimer  :: Int
 --    , _buEffect :: BulletEffect
-    , _buHitEff :: HitEffect'
+--    , _buHitEff :: HitEffect'
     }
-data BulletEffect = BulletSpark
-    | BulletBounce
-    | BulletBall EnergyBall
 
 data EnergyBall = IncBall | TeslaBall | ConcBall
 
@@ -651,10 +655,10 @@ type HitEffect = Particle
     -> World 
     -> (World,Maybe Particle)
 
-type HitEffect' = Bullet 
+--type HitEffect' = Bullet 
-    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+--    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
-    -> World 
+--    -> World 
-    -> (World,Maybe Bullet)
+--    -> (World,Maybe Bullet)
 
 data BulletTrajectory
     = BasicBulletTrajectory
@@ -672,10 +676,13 @@ data AmmoType
         }
     | BulletAmmo
         { _amString :: String 
-        , _amBulEff :: HitEffect'
+--        , _amBulEff :: HitEffect'
+        , _amBulDams :: Bullet -> Point2 -> [Damage]
         , _amBulWth :: Float
         , _amBulVel :: Point2
         , _amBulTraj :: BulletTrajectory
+        , _amBulEffect :: BulletEffect
+        , _amBulSpawn  :: BulletSpawn
         }
     | DroneAmmo
         { _amString :: String }
@@ -1261,7 +1268,6 @@ data DamageEffect
         }
     | TorqueDamage { _deTorque :: Float }
     | PushBackDamage {_dePushBack :: Point2 }
-    | BounceBullet {_bulToBounce :: Bullet}
     | DamageSpawn {_spawnFunc 
         :: Either Creature Wall -> Damage -> State StdGen Particle}
     | DamageSpawn' {_spawnFunc' 

src/Dodge/Item/Weapon/Bullet.hs

@@ -4,22 +4,25 @@ module Dodge.Item.Weapon.Bullet
     ) where
 import Dodge.Data
 import Dodge.Particle.Damage
-import Dodge.Particle.HitEffect.ExpireAndDamage
 
 import Geometry.Data
 basicBullet :: AmmoType
 basicBullet = BulletAmmo
     { _amString = "BASIC"
-    , _amBulEff = expireAndDamage' basicBulDams
+    , _amBulDams = basicBulDams
     , _amBulWth = 2
     , _amBulVel = V2 50 0
     , _amBulTraj = BasicBulletTrajectory
+    , _amBulEffect = DestroyBullet
+    , _amBulSpawn = BulSpark
     }
 hvBullet :: AmmoType
 hvBullet = BulletAmmo
     { _amString = "HVBULLET"
-    , _amBulEff = expireAndDamage' hvBulDams
+    , _amBulDams = hvBulDams
     , _amBulWth = 6
     , _amBulVel = V2 80 0
     , _amBulTraj = BasicBulletTrajectory
+    , _amBulEffect = DestroyBullet
+    , _amBulSpawn = BulSpark
     }

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

@@ -8,16 +8,10 @@ module Dodge.Item.Weapon.BulletGun.Rod
     ) where
 import Dodge.Data
 import Dodge.Reloading.Action
-import Dodge.Particle.HitEffect
 import Dodge.Particle.Damage
---import Dodge.ChainEffect
---import Dodge.TweakBullet
 import Dodge.Default.Weapon
---import Dodge.Item.Weapon.InventoryDisplay
 import Dodge.Default
 import Dodge.Item.Weapon.ZoomScope
---import Dodge.Particle.HitEffect.ExpireAndDamage
---import Dodge.Particle.Damage
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Item.Weapon.TriggerType
 import Dodge.SoundLogic.LoadSound
@@ -63,7 +57,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 . amBulDams .~ heavyBulDams
 elephantGun :: Item
 elephantGun = bangRod
     & itType . iyBase .~ HELD ELEPHANTGUN

src/Dodge/Particle/Damage.hs

@@ -73,13 +73,3 @@ hvBulDams bt p =
     sp = _buPos bt
     bulVel = _buVel bt
     ep = sp +.+ bulVel
-
-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 = _buPos bt
-    bulVel = _buVel bt
-    ep = sp +.+ bulVel

src/Dodge/Wall/DamageEffect.hs

@@ -1,6 +1,5 @@
 module Dodge.Wall.DamageEffect where
 import Dodge.Data
-import Dodge.Bullet
 import Dodge.Spark
 import Dodge.Base.Wall
 import Dodge.Wall.Dust
@@ -132,15 +131,6 @@ dirtWallDamage dm wl = case _dmType dm of
 
 wallDamageEffect :: Damage -> Wall -> World -> World
 wallDamageEffect dm wl w = case _dmEffect dm of
-    BounceBullet bt -> w & instantBullets .:~ thebouncer
-      where
-        reflectVel = reflVelWall wl (_buVel bt)
-        thebouncer = aBulAt Nothing --id 
-            pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) BasicBulletTrajectory
-            & buTimer .~ _buTimer bt - 1
-        pOut = p +.+ squashNormalizeV (sp -.- p)
-        p = _dmAt dm
-        sp = _dmFrom dm
     DamageSpawn f -> w & instantParticles .:~ thepart
         & randGen .~ g
       where