Reify tesla arcs

src/Dodge/Data.hs

@@ -78,7 +78,9 @@ module Dodge.Data
     , module Dodge.Data.Modification
     , module Dodge.Data.PressPlate
     , module Dodge.Data.Laser
+    , module Dodge.Data.TeslaArc
     ) where
+import Dodge.Data.TeslaArc
 import Dodge.Data.Laser
 import Dodge.Data.PressPlate
 import Dodge.Data.Modification
@@ -222,6 +224,7 @@ data World = World
     , _flares           :: [Flare]
     , _newBeams         :: WorldBeams
     , _beams            :: WorldBeams
+    , _teslaArcs        :: [TeslaArc]
     , _lasers           :: [LaserStart]
     , _lasersToDraw     :: [Laser]
     , _walls            :: IM.IntMap Wall
@@ -374,13 +377,7 @@ data WorldBeams = WorldBeams
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}
 data Particle
-    = PtTeslaArc 
+    = PtTargetLaser
-        { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
-        , _ptPoints :: [Point2]
-        , _ptTimer :: Int
-        , _ptColor :: Color
-        }
-    | PtTargetLaser
         { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptPoints :: [Point2]
         , _ptColor  :: Color

src/Dodge/Data/TeslaArc.hs

@@ -4,9 +4,12 @@ module Dodge.Data.TeslaArc where
 import Geometry.Data
 import Color
 import Control.Lens
+import Dodge.Data.ArcStep
 data TeslaArc = TeslaArc
     { _taPoints :: [Point2]
     , _taTimer :: Int
+    , _taArcSteps :: [ArcStep]
     , _taColor :: Color
     }
+  deriving (Eq,Ord,Show,Read)
 makeLenses ''TeslaArc

src/Dodge/Default/World.hs

@@ -45,6 +45,7 @@ defaultWorld = World
     , _flares           = []
     , _newBeams         = WorldBeams [] [] [] []
     , _beams            = WorldBeams [] [] [] []
+    , _teslaArcs        = []
     , _lasers           = []
     , _lasersToDraw     = []
     , _walls            = IM.empty

src/Dodge/Particle/Draw.hs

@@ -7,7 +7,6 @@ drawParticle :: Particle -> Picture
 drawParticle pt = case pt of
     Shockwave {} -> drawShockwave pt
     PtInvShockwave {} -> drawInverseShockwave pt
-    PtTeslaArc {} -> drawTeslaArc pt
     PtTargetLaser {} -> drawTargetLaser pt
     ShockLine {} -> drawSonicWave pt
 
@@ -34,13 +33,13 @@ drawInverseShockwave  pt
     rad = r - 0.1 * r * fromIntegral (10 - t)
     thickness = fromIntegral (10 - t) **2 * rad / 40
 
-drawTeslaArc :: Particle -> Picture
+--drawTeslaArc :: Particle -> Picture
-drawTeslaArc pt = setLayer BloomNoZWrite $ pictures 
+--drawTeslaArc pt = setLayer BloomNoZWrite $ pictures 
-    [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine  3 ps
+--    [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine  3 ps
-    , setDepth 20   $ color (V4 0 0 0 0.5)              $ thickLine 10 ps
+--    , setDepth 20   $ color (V4 0 0 0 0.5)              $ thickLine 10 ps
-    ]
+--    ]
-  where
+--  where
-    ps = _ptPoints pt
+--    ps = _ptPoints pt
 
 drawTargetLaser :: Particle -> Picture
 drawTargetLaser pt = setLayer BloomNoZWrite $ pictures

src/Dodge/Render/ShapePicture.hs

@@ -1,6 +1,7 @@
 module Dodge.Render.ShapePicture
     ( worldSPic
     ) where
+import Dodge.Tesla.Arc.Draw
 import Dodge.Laser.Draw
 import Dodge.Cloud.Draw
 import Dodge.Zoning
@@ -128,6 +129,7 @@ cullPoint cfig w p
 extraPics :: Configuration -> World -> Picture
 extraPics cfig w = pictures (_decorations w)
     <> concatMapPic drawLaser (_lasersToDraw w)
+    <> concatMapPic drawTeslaArc (_teslaArcs w)
     <> concatMapPic drawParticle (_particles    w)
     <> concatMapPic drawRadarSweep (_radarSweeps    w)
     <> concatMapPic drawFlame (_flames    w)

src/Dodge/Tesla/Arc.hs

@@ -32,23 +32,23 @@ import MonadHelp
 import Data.Maybe
 --import qualified IntMapHelp as IM
 
-aTeslaArcAt :: Color -> [ArcStep] -> Particle
+aTeslaArcAt :: Color -> [ArcStep] -> TeslaArc
-aTeslaArcAt col thearc = PtTeslaArc
+aTeslaArcAt col thearc = TeslaArc
-    { _ptPoints = map (^. asPos) thearc
+    { _taPoints = map (^. asPos) thearc
-    , _ptUpdate = moveTeslaArc thearc
+    , _taArcSteps = thearc
-    , _ptTimer = 2
+    , _taTimer = 2
-    , _ptColor = brightX 100 1.5 col
+    , _taColor = brightX 100 1.5 col
     }
 
-moveTeslaArc :: [ArcStep]
+moveTeslaArc :: World
-    -> World
+    -> TeslaArc
-    -> Particle
+    -> (World,Maybe TeslaArc)
-    -> (World,Maybe Particle)
+moveTeslaArc w pt
-moveTeslaArc thearc w pt
+    | _taTimer pt == 2  = (makesparks $ foldr damthings w thearc, Just $ pt & taTimer -~ 1)
-    | _ptTimer pt == 2  = (makesparks $ foldr damthings w thearc, Just $ pt & ptTimer -~ 1)
+    | _taTimer pt < 1   = (w, Nothing)
-    | _ptTimer pt < 1   = (w, Nothing)
+    | otherwise         = (w, Just $ pt & taTimer -~ 1)
-    | otherwise         = (w, Just $ pt & ptTimer -~ 1)
   where
+    thearc = _taArcSteps pt
     rcol = brightX 100 1.5 <$> takeOne [white,azure,blue,cyan]
     rdir = state (randomR (-0.7,0.7)) <&> (+ ld)
     rspeed = state (randomR (3,6))
@@ -71,7 +71,7 @@ moveTeslaArc thearc w pt
 shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams)
 shootTeslaArc' ip pos dir w = 
     (w & randGen .~ g
-       & instantParticles .:~ aTeslaArcAt col newarc
+       & teslaArcs .:~ aTeslaArcAt col newarc
     , ip & currentArc ?~ newarc
     )
   where

src/Dodge/Update.hs

@@ -4,6 +4,7 @@ Module      : Dodge.Update
 Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
+import Dodge.Tesla.Arc
 import Dodge.Laser.Update
 import Dodge.PressPlate
 import Dodge.ModificationEffect
@@ -96,6 +97,7 @@ functionalUpdate w = checkEndGame
     . over uvWorld updateFlares
     . over uvWorld updateBeams
     . over uvWorld updateLasers
+    . over uvWorld updateTeslaArcs
     . over uvWorld (updateIMl _props _pjUpdate              )
     . over uvWorld (updateIMl' _projectiles updateProjectile)
     . over uvWorld updateLightSources
@@ -229,6 +231,12 @@ updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip
 updateFlares :: World -> World
 updateFlares = flares %~ mapMaybe updateFlare
 
+updateTeslaArcs :: World -> World
+updateTeslaArcs w = w' & teslaArcs .~ catMaybes newtas
+  where
+    (w',newtas) = mapAccumR moveTeslaArc w $ _teslaArcs w
+
+
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateBullets :: World -> World
 updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w'