Cleanup bullet damage

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -15,6 +15,7 @@ import Dodge.RandomHelp
 import Dodge.WorldEvent.Shockwave
 import Dodge.Creature.State.Data
 import Dodge.Creature.Property
+import Dodge.Wall.Reflect
 import Geometry
 --import Geometry.Vector3D
 import Picture
@@ -118,18 +119,17 @@ bulIncCr' bt p cr w
     v = evalState (randInCirc 1) $ _randGen w
     incFlamelets = over worldEvents $ (.) (makeFlameletTimed p 20 v Nothing 3 20)
 {- | Creates a shockwave when hitting a creature.  -}
-bulConCr' :: Particle -> Point2 -> Creature -> World -> World
-bulConCr' bt p cr w 
+bulConCr :: Particle -> Point2 -> Creature -> World -> World
+bulConCr bt p cr w 
     = over (creatures . ix cid . crState . crDamage)
-           ( Piercing 60 sp p ep : )
+           ( Blunt 10 sp p ep : )
     $ bulletHitSound p
-    $ mkwave
+    $ (worldEvents %~ (makeShockwaveAt [] p 15 4 1 white . ))
     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 = damageWall (Piercing 100 sp p ep)
@@ -145,8 +145,7 @@ bulBounceWall bt p wl = damageWall (Blunt 50 sp p ep) wl . over worldEvents addB
     pOut = p +.+ safeNormalizeV (sp -.- p)
     bouncer = (aGenBulAt Nothing pOut reflectVel (_btHitEffect' bt) (_btWidth' bt)
               ) {_btTimer' = _btTimer' bt - 1}
-    wallV = uncurry (-.-) (_wlLine wl)
-    reflectVel = reflectIn wallV (_btVel' bt)
+    reflectVel = reflVelWall wl (_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
@@ -168,14 +167,17 @@ bulIncWall bt p wl =  damageWall (Blunt 50 sp p ep) wl . incFlamelets
     reflectVel = safeNormalizeV $ reflectIn wallV (_btVel' bt)
     incFlamelets = over worldEvents $ (.) (makeFlameletTimed pOut 20 reflectVel Nothing 3 20)
 {- | Create a shockwave on wall-}
-bulConWall'
+bulConWall
     :: Particle 
     -> Point2   -- ^ Impact point
     -> Wall 
     -> World 
     -> World
-bulConWall' _ p wl = damageBlocksBy 1 wl . 
+bulConWall bt p wl = damageWall (Blunt 10 sp p ep) wl .
     over worldEvents ( makeShockwaveAt [] p 15 4 1 white . ) 
+  where   
+    ep = sp +.+ _btVel' bt
+    sp = head $ _btTrail' bt
 
 hvBulHitWall 
     :: Particle 
@@ -183,14 +185,15 @@ hvBulHitWall
     -> Wall 
     -> World 
     -> World
-hvBulHitWall bt p x w =  damageBlocksBy 5 x $ set randGen g $ foldr ($) w (sparks pOut sv)
+hvBulHitWall bt p wl w = damageWall (Piercing 200 sp p ep) wl 
+    . damageWall (Blunt 100 sp p ep) wl  
+    $ set randGen g $ foldr ($) w (sparks pOut sv)
   where 
+    ep = sp +.+ _btVel' bt
     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
+    sv = unitVectorAtAngle $ a + reflDirWall sp p wl
     cs'      = take 10 $ randomRs (0,11) $ _randGen w
     cs      = map (brightX 100 1.5 . numColor) cs'
     ts      = randomRs (4,8) $ _randGen w

src/Dodge/Wall/Damage.hs

@@ -9,6 +9,7 @@ import Dodge.Data
 import Dodge.Data.DamageType
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.Cloud
+import Dodge.Wall.Reflect
 import Geometry
 import Geometry.Vector3D
 import Color
@@ -41,8 +42,6 @@ wallEff dt wl = case dt of
     pSparkCol = brightX 100 1.5 white
     lSparkCol = V4 20 (-5) 0 1
 
-reflDirWall :: Point2 -> Point2 -> Wall -> Float
-reflDirWall sp ep wl = argV (reflectIn (uncurry (-.-) (_wlLine wl)) (ep -.- sp))
 
 damageBlockWith :: DamageType -> Block -> Block
 damageBlockWith dt = case dt of

src/Dodge/Wall/Reflect.hs

@@ -0,0 +1,11 @@
+module Dodge.Wall.Reflect
+    where
+import Geometry
+import Dodge.Data
+
+reflDirWall :: Point2 -> Point2 -> Wall -> Float
+reflDirWall sp ep wl = argV (reflectIn (uncurry (-.-) (_wlLine wl)) (ep -.- sp))
+
+-- point free nonsense
+reflVelWall :: Wall -> Point2 -> Point2
+reflVelWall = reflectIn . uncurry (-.-) . _wlLine