Add bullet damages field, move bullet data into own file

src/Dodge/Bullet.hs

@@ -1,5 +1,5 @@
 module Dodge.Bullet where
-import Dodge.Particle.Damage
+import Dodge.WorldEvent.SpawnParticle
 import Dodge.Creature.Test
 import Dodge.Data
 import Dodge.Particle.HitEffect.ExpireAndDamage
@@ -14,6 +14,8 @@ import qualified Streaming.Prelude as S
 import Data.Maybe
 import Dodge.Movement.Turn
 import Dodge.WorldEvent.ThingsHit
+import Control.Monad.State
+import System.Random
 
 --import Data.Bifunctor
 
@@ -33,8 +35,9 @@ aBulAt
     -> BulletTrajectory
     -> BulletEffect
     -> BulletSpawn
+    -> [Damage]
     -> Bullet
-aBulAt vfact pos vel drag width butraj be bs = Bullet
+aBulAt vfact pos vel drag width butraj be bs dams = Bullet
     { _buState = bulstate
     , _buSpawn = bs
     , _buEffect = be
@@ -46,6 +49,7 @@ aBulAt vfact pos vel drag width butraj be bs = Bullet
     , _buOldPos = pos
     , _buWidth = width
     , _buTimer = 100
+    , _buDamages = dams
     }
   where
     bulstate = maybe NormalBulletState DelayedBullet vfact
@@ -60,6 +64,7 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
     thetraj
     (_amBulEffect bultype)
     (_amBulSpawn bultype)
+    (_amBulDams bultype)
   where
     sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
     dir = _crDir cr
@@ -87,15 +92,21 @@ 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 = bimap maybebounce (fmap dodrag) $ 
+    | otherwise = bimap (maybespawn . maybebounce) (fmap dodrag) $ 
         hiteff bt hitstream w
   where
+    maybespawn w' = fromMaybe w' $ do
+        (hp,_) <- runIdentity (S.head_ hitstream)
+        partspawn <- bulletSpawn bt'
+        let (thepart,g) = runState (partspawn hp) $ _randGen w'
+        return $ w' & instantParticles .:~ thepart
+            & randGen .~ g
     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)
+                            BasicBulletTrajectory (_buEffect bt) (_buSpawn bt) (_buDamages bt)
                           ) {_buTimer = _buTimer bt - 1}
                 pOut = hp +.+ 2 *.* newDir
                 reflectVel = magV bulVel *.* newDir
@@ -106,7 +117,7 @@ mvBullet w bt'
                 reflectVel = reflVelWall wl (_buVel bt)
                 thebouncer = aBulAt Nothing --id 
                     pOut reflectVel (_buDrag bt) (_buWidth bt) BasicBulletTrajectory (_buEffect bt)
-                        (_buSpawn bt)
+                        (_buSpawn bt) (_buDamages bt)
                     & buTimer .~ _buTimer bt - 1
                 pOut = hp +.+ squashNormalizeV (p -.- hp)
             _ -> id
@@ -125,31 +136,23 @@ mvBullet w bt'
     vel     = _buVel 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
+
+bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle)
+bulletSpawn bu = case _buSpawn bu of
+    BulSpark -> Nothing
+    BulBall IncBall -> Just incBall
+    BulBall ConcBall -> Just concBall
+    BulBall TeslaBall -> Just aStaticBall
 
 hitEffFromBul :: Bullet
     -> Stream (Of (Point2, Either Creature Wall)) Identity ()
     -> World 
     -> (World,Maybe Bullet)
-hitEffFromBul = expireAndDamage' basicBulDams
+hitEffFromBul = expireAndDamage' setfromtodams
+  where
+    setfromtodams bu p = map f (_buDamages bu)
+      where
+        f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu)
 
 mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet)
 mvBulletSlow x w bt'