Move sparks into dedicated datatype

src/Dodge/Spark.hs

@@ -1,5 +1,5 @@
 module Dodge.Spark
-    ( mvSpark
+    ( moveSpark
     , colSpark
     , colSparkRandDir
     , createBarrelSpark
@@ -9,86 +9,79 @@ import Dodge.Data
 import Dodge.WorldEvent.ThingsHit
 import Geometry
 import LensHelp
-import Dodge.Particle.HitEffect.ExpireAndDamage
-import Dodge.Particle.Damage
 import Color
 
 import Control.Monad.State
 import System.Random
 
-import Data.Bifunctor
-
-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
+moveSpark :: World -> Spark -> (World, Maybe Spark)
+moveSpark w sk
+    | magV (_skVel sk) < 1 = (w,Nothing)
+    | otherwise = case thingHit sp ep w of
+        Nothing -> (w, Just $ sk & skPos .~ ep & skVel .*.*~ 0.9 & skOldPos .~ sp)
+        Just (hp,hthing) -> (sparkDam sp ep (hp,hthing) w, Just $ sk & skPos .~ hp & skOldPos .~ sp & skVel .~ 0)
   where
-    bt = bt'
-    dodrag = ptVel .*.*~ drag
-    drag = _ptDrag bt
-    (p:_)   = _ptTrail bt
-    vel     = _ptVel bt
-    hiteff  = _ptHitEff bt
-    t       = _ptTimer bt
+    sp = _skPos sk
+    ep = sp +.+ _skVel sk
+
+sparkDam 
+    :: Point2
+    -> Point2
+    -> (Point2, Either Creature Wall)
+    -> World 
+    -> World
+sparkDam sp ep mayEiCrWl = case mayEiCrWl of
+    (hitp,Left  cr) -> creatures . ix (_crID cr) . crState . csDamage .:~ thedam hitp
+    (hitp,Right wl) -> wallDamages . ix (_wlID wl) .:~ thedam hitp
+  where
+    thedam hitp = Damage SPARKING 1 sp hitp ep NoDamageEffect
 
 --import Control.Lens
 -- TODO remove/simplify this function
-createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World
-createBarrelSpark pos dir time colid = instantParticles .:~ PtSpark  
-    { _ptUpdate = mvSpark
-    , _ptVel = rotateV dir (V2 5 0)
-    , _ptDrag = 0.9
-    , _ptColor = numColor colid
-    , _ptTrail = [pos]
-    , _ptWidth = 1
-    , _ptTimer = time
-    , _ptHitEff = expireAndDamage basicSparkDams
+createBarrelSpark :: Point2 -> Float -> Int -> World -> World
+createBarrelSpark pos dir colid = sparks .:~ Spark  
+    { _skVel = rotateV dir (V2 5 0)
+    , _skColor = numColor colid
+    , _skPos = pos
+    , _skOldPos = pos
+    , _skWidth = 1
     }
-colSpark :: Int -> Color -> Point2 -> Float -> World -> World
+colSpark :: Color -> Point2 -> Float -> World -> World
 colSpark = colSparkRandDir 0.7
 
 randColDirTimeSpark 
     :: State StdGen Color 
     -> State StdGen Float 
-    -> State StdGen Int 
     -> Point2
     -> World
     -> World
-randColDirTimeSpark randcol randdir randtime pos w = w
-    & instantParticles .:~ spark
+randColDirTimeSpark randcol randdir pos w = w
+    & sparks .:~ spark
     & randGen .~ g
   where
-    ((col,dir,time),g) = (`runState` _randGen w) $ do
+    ((col,dir),g) = (`runState` _randGen w) $ do
         c <- randcol
         d <- randdir
-        t <- randtime
-        return (c,d,t)
-    spark = PtSpark
-        { _ptUpdate = mvSpark
-        , _ptDrag   = 0.9
-        , _ptVel    = rotateV dir (V2 5 0)
-        , _ptColor  = col
-        , _ptTrail  = [pos]
-        , _ptWidth = 1
-        , _ptTimer = time
-        , _ptHitEff = expireAndDamage basicSparkDams
+        return (c,d)
+    spark = Spark
+        { _skVel    = rotateV dir (V2 5 0)
+        , _skColor  = col
+        , _skPos  = pos
+        , _skOldPos  = pos
+        , _skWidth = 1
         }
 
-colSparkRandDir :: Float -> Int -> Color -> Point2 -> Float -> World -> World
-colSparkRandDir randDir time col pos baseDir w = w 
-    & instantParticles .:~ spark
+colSparkRandDir :: Float -> Color -> Point2 -> Float -> World -> World
+colSparkRandDir randDir col pos baseDir w = w 
+    & sparks .:~ spark
     & randGen .~ g
   where
     (a,g)  = randomR (-randDir,randDir) $ _randGen w
     dir = a + baseDir
-    spark = PtSpark
-        { _ptUpdate = mvSpark
-        , _ptDrag   = 0.9
-        , _ptVel = rotateV dir (V2 5 0)
-        , _ptColor = col
-        , _ptTrail = [pos]
-        , _ptWidth = 1
-        , _ptTimer = time
-        , _ptHitEff = expireAndDamage basicSparkDams
+    spark = Spark
+        { _skVel = rotateV dir (V2 5 0)
+        , _skColor = col
+        , _skPos = pos
+        , _skOldPos = pos
+        , _skWidth = 1
         }