Simplify sparks

src/Dodge/Barreloid.hs

@@ -25,13 +25,11 @@ updateExpBarrel cr w
     damages = _csDamage $ _crState cr
     pierceSparks :: [World -> World]
     pierceSparks =
-        zipWith3
+        zipWith
             (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p))
             poss
             as
-            colids
     as = randomRs (-0.7, 0.7) g
-    colids = randomRs (0, 11) g
     poss = _piercedPoints $ _csSpState $ _crState cr
     newCr = Just $ applyFuseDamage $ set (crState . csDamage) [] $ damsToExpBarrel damages cr
     applyFuseDamage cr' =

src/Dodge/Creature/Damage.hs

@@ -2,7 +2,6 @@ module Dodge.Creature.Damage where
 
 import Dodge.Creature.Material
 import Dodge.Creature.Mass
-import Color
 import Data.List
 import Dodge.Creature.Test
 import Dodge.Data.World
@@ -58,7 +57,7 @@ applyIndividualDamage' cr w dm = case _dmType dm of
 
 applyPiercingDamage :: Creature -> Damage -> World -> World
 applyPiercingDamage cr dm
-    | crIsArmouredFrom p cr = colSpark (brightX 10 1.5 orange) p1 (argV (p1 -.- p))
+    | crIsArmouredFrom p cr = makeSpark NormalSpark p1 (argV (p1 -.- p))
     | otherwise = damageHP cr $ _dmAmount dm
   where
     p = _dmAt dm

src/Dodge/Data/Machine/Sensor.hs

@@ -20,8 +20,7 @@ data Sensor
     = DamageSensor
         { _sensToggle :: Bool
         , _sensAmount :: Int
-        , --        , _sensType :: DamageType
-          _sensType :: SensorType
+        , _sensType :: SensorType
         , _sensDraw :: (PaletteColor, DecorationShape)
         , _sensThreshold :: Int
         }

src/Dodge/Data/Spark.hs

@@ -5,22 +5,23 @@
 
 module Dodge.Data.Spark where
 
-import Color
 import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
-import Dodge.Data.Damage.Type
+--import Dodge.Data.Damage.Type
 import Geometry.Data
 
 data Spark = Spark
     { _skVel :: Point2
-    , _skColor :: Color
     , _skPos :: Point2
     , _skOldPos :: Point2
-    , _skWidth :: Float
-    , _skDamageType :: DamageType
+    , _skType :: SparkType
     }
     deriving (Eq, Ord, Show, Read) --Generic, Flat)
 
+data SparkType = ElectricSpark | FireSpark | NormalSpark
+    deriving (Eq, Ord, Show, Read) --Generic, Flat)
+
 makeLenses ''Spark
+deriveJSON defaultOptions ''SparkType
 deriveJSON defaultOptions ''Spark

src/Dodge/Machine/Update.hs

@@ -152,7 +152,6 @@ mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
   where
     cr = you w
 
---senseDamage :: Int -> DamageType -> Machine -> World -> World
 senseDamage :: Int -> SensorType -> Machine -> World -> World
 senseDamage threshold dt mc =
     (cWorld . lWorld . machines . ix mcid %~ upmc)

src/Dodge/Material/Damage.hs

@@ -19,8 +19,8 @@ defDamageMaterial dm _ w = (_dmAmount dm, w)
 
 damageStone :: Damage -> Float -> World -> (Int, World)
 damageStone dm dir = case _dmType dm of
-    LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (argV $ reflectIn (p -.- sp) v)
-    PIERCING -> a d $ colSparkRandDir 0.2 pSparkCol outTo (argV $ reflectIn (p -.- sp) v)
+    LASERING -> a 0 $ makeSpark NormalSpark outTo (argV $ reflectIn (p -.- sp) v)
+    PIERCING -> a d $ makeSpark FireSpark outTo (argV $ reflectIn (p -.- sp) v)
     BLUNT -> a d id
     SHATTERING -> a d id
     CRUSHING -> a d id
@@ -39,8 +39,6 @@ damageStone dm dir = case _dmType dm of
     sp = _dmFrom dm
     p = _dmAt dm
     outTo = p +.+ squashNormalizeV (sp -.- p)
-    pSparkCol = V4 5 1 0.5 2
-    lSparkCol = V4 20 (-5) 0 1
 
 --damageGlass :: Damage -> Float -> World -> (World,Int)
 --damageGlass dm dir w = w & case _dmType dm of

src/Dodge/PosEvent.hs

@@ -1,6 +1,5 @@
 module Dodge.PosEvent where
 
-import Color
 import Control.Monad.State
 import Dodge.Data.World
 import Dodge.Spark
@@ -18,8 +17,7 @@ posEventEffect pv = case _pvType pv of
     SparkSpawner -> spawnElectricalSparks (_pvPos pv)
 
 spawnElectricalSparks :: Point2 -> World -> World
-spawnElectricalSparks = randSpark ELECTRICAL rspeed rcol rdir
+spawnElectricalSparks = randSpark ElectricSpark rspeed rdir
   where
     rspeed = state (randomR (3, 6))
-    rcol = brightX 100 1.5 <$> takeOne [white, azure, blue, cyan]
     rdir = state $ randomR (0, 2 * pi)

src/Dodge/Spark.hs

@@ -1,14 +1,13 @@
 module Dodge.Spark (
     updateSpark,
-    colSpark,
-    colSparkRandDir,
+    sparkRandDir,
     createBarrelSpark,
-    randColDirSpark,
+    randDirSpark,
     randSpark,
+    makeSpark,
 ) where
 
 import Dodge.Damage
-import Color
 import Control.Monad.State
 import Dodge.Data.World
 import Dodge.WorldEvent.ThingsHit
@@ -16,6 +15,7 @@ import Geometry
 import LensHelp
 import System.Random
 
+
 updateSpark :: World -> Spark -> (World, Maybe Spark)
 updateSpark w sk
     | magV (_skVel sk) < 1 = (w, Nothing)
@@ -40,68 +40,71 @@ sparkDam' ::
 sparkDam' sk sp ep mayEiCrWl = case mayEiCrWl of
     (hitp, eicrwl) -> damageCrWl (thedam hitp) eicrwl
   where
-    thedam hitp = Damage (_skDamageType sk) 1 sp hitp ep NoDamageEffect
+    thedam hitp = Damage (sparkToDamage sk) 10 sp hitp ep NoDamageEffect
 
-createBarrelSpark :: Point2 -> Float -> Int -> World -> World
-createBarrelSpark pos dir colid = colSparkRandDir 0.1 (numColor colid) pos dir
+sparkToDamage :: Spark -> DamageType
+sparkToDamage sp = case _skType sp of
+     ElectricSpark ->ELECTRICAL
+     FireSpark -> FLAMING
+     NormalSpark -> SPARKING
 
-colSpark :: Color -> Point2 -> Float -> World -> World
-colSpark = colSparkRandDir 0.7
+createBarrelSpark :: Point2 -> Float -> World -> World
+createBarrelSpark pos dir = sparkRandDir 0.1 pos dir
 
-randColDirSpark ::
-    State StdGen Color ->
+makeSpark :: SparkType -> Point2 -> Float -> World -> World
+makeSpark st p d =  cWorld . lWorld . sparks
+            .:~ Spark
+                { _skVel = rotateV d (V2 5 0)
+                , _skPos = p
+                , _skOldPos = p
+                , _skType = st
+                }
+
+randDirSpark ::
     State StdGen Float ->
     Point2 ->
     World ->
     World
-randColDirSpark randcol randdir pos w =
+randDirSpark randdir pos w =
     w
         & randGen .~ g
         & cWorld . lWorld . sparks
             .:~ Spark
                 { _skVel = rotateV dir (V2 5 0)
-                , _skColor = col
                 , _skPos = pos
                 , _skOldPos = pos
-                , _skWidth = 1
-                , _skDamageType = SPARKING
+                , _skType = NormalSpark
                 }
   where
-    ((col, dir), g) = (`runState` _randGen w) $ do
-        c <- randcol
+    (dir, g) = (`runState` _randGen w) $ do
         d <- randdir
-        return (c, d)
+        return d
 
 randSpark ::
-    DamageType ->
+    SparkType ->
     State StdGen Float ->
-    State StdGen Color ->
     State StdGen Float ->
     Point2 ->
     World ->
     World
-randSpark dt randspeed randcol randdir pos w =
+randSpark dt randspeed randdir pos w =
     w
         & randGen .~ g
         & cWorld . lWorld . sparks
             .:~ Spark
                 { _skVel = rotateV dir (V2 speed 0)
-                , _skColor = col
                 , _skPos = pos
                 , _skOldPos = pos
-                , _skWidth = 1
-                , _skDamageType = dt
+                , _skType = dt
                 }
   where
-    ((col, dir, speed), g) = (`runState` _randGen w) $ do
-        c <- randcol
+    ((dir, speed), g) = (`runState` _randGen w) $ do
         d <- randdir
         x <- randspeed
-        return (c, d, x)
+        return (d, x)
 
-colSparkRandDir :: Float -> Color -> Point2 -> Float -> World -> World
-colSparkRandDir a col pos dir =
-    randColDirSpark
-        (return col)
+sparkRandDir :: Float -> Point2 -> Float -> World -> World
+sparkRandDir a pos dir =
+    randDirSpark
         (state $ randomR (dir - a, dir + a))
         pos

src/Dodge/Spark/Draw.hs

@@ -1,11 +1,18 @@
-module Dodge.Spark.Draw where
+module Dodge.Spark.Draw (drawSpark) where
 
 import Dodge.Data.Spark
 import Picture
+import Linear
 
 drawSpark :: Spark -> Picture
 drawSpark pt =
     setLayer BloomNoZWrite
         . setDepth 20
-        . color (_skColor pt)
-        $ thickLine (_skWidth pt) [_skOldPos pt, _skPos pt]
+        . color (skColor pt)
+        $ thickLine 3 [_skOldPos pt, _skPos pt, _skPos pt + _skVel pt]
+
+skColor :: Spark -> Color
+skColor sk = case _skType sk of
+    ElectricSpark -> brightX 100 1.5 cyan
+    FireSpark -> V4 20 (-5) 0 1
+    NormalSpark -> V4 2 1.5 0.5 2

src/Dodge/TestString.hs

@@ -26,7 +26,7 @@ import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^. uvWorld . unpauseClock]
+testStringInit _ = []
 --    foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crTwist
 --    prettyShort $ u ^.. uvWorld . cWorld . lWorld . teslaArcs . ix 0 . taArcSteps . each . asObject
 --testStringInit u = foldMap prettyShort $ u ^. uvWorld . cWorld . lWorld . projectiles

src/Dodge/Update.hs

@@ -559,9 +559,8 @@ updateTeslaArc w pt
     thearc = _taArcSteps pt
     makeaspark =
         randSpark
-            ELECTRICAL
+            ElectricSpark
             (state (randomR (3, 6)))
-            (brightX 100 1.5 <$> takeOne [white, azure, blue, cyan])
             rdir
             lp
     makesparks = makeaspark . makeaspark . makeaspark

src/Dodge/Wall/DamageEffect.hs

@@ -23,8 +23,8 @@ damageWallEffect dm wl = case _wlMaterial wl of
 
 stoneWallDamage :: Damage -> Wall -> World -> (World, Damage)
 stoneWallDamage dm wl = case _dmType dm of
-    LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
-    PIERCING -> a d $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
+    PIERCING -> a d $ makeSpark NormalSpark outTo (reflDirWall sp p wl) . wlDustAt wl outTo
+    LASERING -> a 0 $ makeSpark FireSpark outTo (reflDirWall sp p wl)
     BLUNT -> a d $ wlDustAt wl outTo
     SHATTERING -> a d $ muchWlDustAt wl outTo
     CRUSHING -> a d id
@@ -42,14 +42,12 @@ stoneWallDamage dm wl = case _dmType dm of
     sp = _dmFrom dm
     p = _dmAt dm
     outTo = p +.+ squashNormalizeV (sp -.- p)
-    pSparkCol = V4 5 1 0.5 2
-    lSparkCol = V4 20 (-5) 0 1
 
 glassWallDamage :: Damage -> Wall -> World -> (World, Damage)
 glassWallDamage dm wl w =
     w & case _dmType dm of
-        LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
-        PIERCING -> a d $ dosplint . colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
+        LASERING -> a 0 $ makeSpark FireSpark outTo (reflDirWall sp p wl)
+        PIERCING -> a d $ dosplint . makeSpark NormalSpark outTo (reflDirWall sp p wl) . wlDustAt wl outTo
         BLUNT -> a d $ dosplint . wlDustAt wl outTo
         SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo
         CRUSHING -> a d dosplint
@@ -73,13 +71,11 @@ glassWallDamage dm wl w =
     sp = _dmFrom dm
     p = _dmAt dm
     outTo = p +.+ squashNormalizeV (sp -.- p)
-    pSparkCol = V4 5 1 0.5 2
-    lSparkCol = V4 20 (-5) 0 1
 
 crystalWallDamage :: Damage -> Wall -> World -> (World, Damage)
 crystalWallDamage dm wl = case _dmType dm of
-    LASERING -> a 0 $ colSparkRandDir 0.2 lSparkCol outTo (reflDirWall sp p wl)
-    PIERCING -> a 0 $ colSparkRandDir 0.2 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
+    LASERING -> a 0 $ makeSpark FireSpark outTo (reflDirWall sp p wl)
+    PIERCING -> a 0 $ makeSpark NormalSpark outTo (reflDirWall sp p wl)-- . wlDustAt wl outTo
     BLUNT -> a 0 $ wlDustAt wl outTo
     SHATTERING -> a d $ muchWlDustAt wl outTo
     CRUSHING -> a 0 id
@@ -97,8 +93,6 @@ crystalWallDamage dm wl = case _dmType dm of
     sp = _dmFrom dm
     p = _dmAt dm
     outTo = p +.+ squashNormalizeV (sp -.- p)
-    pSparkCol = V4 5 1 0.5 2
-    lSparkCol = V4 20 (-5) 0 1
 
 dirtWallDamage :: Damage -> Wall -> World -> (World, Damage)
 dirtWallDamage dm wl = case _dmType dm of