Continue bullet refactor

src/Dodge/Spark.hs

@@ -0,0 +1,94 @@
+module Dodge.Spark
+    ( mvSpark
+    , colSpark
+    , colSparkRandDir
+    , createBarrelSpark
+    , randColDirTimeSpark
+    ) where
+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
+  where
+    bt = bt'
+    dodrag = ptVel .*.*~ drag
+    drag = _ptDrag bt
+    (p:_)   = _ptTrail bt
+    vel     = _ptVel bt
+    hiteff  = _ptHitEff bt
+    t       = _ptTimer bt
+
+--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
+    }
+colSpark :: Int -> 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
+    & randGen .~ g
+  where
+    ((col,dir,time),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
+        }
+
+colSparkRandDir :: Float -> Int -> Color -> Point2 -> Float -> World -> World
+colSparkRandDir randDir time col pos baseDir w = w 
+    & instantParticles .:~ 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
+        }