Move flame into its own datatype

src/Dodge/Tesla/Arc.hs

@@ -0,0 +1,118 @@
+module Dodge.Tesla.Arc
+    where
+import Dodge.Data
+import Dodge.Damage
+import Dodge.Spark
+import RandomHelp
+import Picture
+import Geometry
+import LensHelp
+--import Dodge.Data
+--import Geometry
+--import LensHelp
+--import RandomHelp
+--import Color
+--import Dodge.Item.Location
+--import Dodge.WorldEvent.Damage
+--import Dodge.WorldEvent.ThingsHit
+--import Dodge.WorldEvent.HelperParticle
+--import Dodge.Item.Weapon.LaserPath
+--import Geometry
+--import LensHelp
+--import Picture
+--import RandomHelp
+--import Dodge.Zone
+--import Dodge.Base.Collide
+--import Shape
+
+--import qualified Data.IntMap.Strict as IM
+--import Data.List (sortOn)
+import MonadHelp
+import Data.Maybe
+--import qualified Data.IntMap.Strict as IM
+
+aTeslaArcAt :: Color -> [ArcStep] -> Particle
+aTeslaArcAt col thearc = PtTeslaArc
+    { _ptPoints = map (^. asPos) thearc
+    , _ptUpdate = moveTeslaArc thearc
+    , _ptTimer = 2
+    , _ptColor = brightX 100 1.5 col
+    }
+
+moveTeslaArc :: [ArcStep]
+    -> World
+    -> Particle
+    -> (World,Maybe Particle)
+moveTeslaArc thearc w pt
+    | _ptTimer pt == 2  = (makesparks $ foldr damthings w thearc, Just $ pt & ptTimer -~ 1)
+    | _ptTimer pt < 1   = (w, Nothing)
+    | otherwise         = (w, Just $ pt & ptTimer -~ 1)
+  where
+    rcol = brightX 100 1.5 <$> takeOne [white,azure,blue,cyan]
+    rdir = state (randomR (-0.7,0.7)) <&> (+ ld)
+    rspeed = state (randomR (3,6))
+    makeaspark = randSpark ELECTRICAL rspeed rcol rdir lp
+    makesparks = makeaspark . makeaspark . makeaspark
+    (lp,ld) = case last thearc of
+        ArcStep lp' ld' Nothing -> (lp',ld')
+        ArcStep lp' ld' (Just (Left cr)) -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld',ld'+pi)
+        ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
+    damthings (ArcStep _ _ Nothing) = id
+    damthings (ArcStep p dir (Just crwl)) = damageCrWall (thedamage p dir) crwl
+    thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect
+      where
+        q = 5 *.* unitVectorAtAngle dir
+
+shootTeslaArc' :: ItemParams -> Point2 -> Float -> World -> (World,ItemParams)
+shootTeslaArc' ip pos dir w = 
+    (w & randGen .~ g
+       & instantParticles .:~ aTeslaArcAt col newarc
+    , ip & currentArc ?~ newarc
+    )
+  where
+    (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
+    newarc = createArc ip w pos dir & evalState $ _randGen w
+
+createArc :: ItemParams
+    -> World
+    -> Point2
+    -> Float
+    -> State StdGen [ArcStep]
+createArc arcparams@Arcing{_currentArc = Nothing} w p dir = createNewArc arcparams w p dir
+createArc arcparams w p dir = updateArc arcparams w p dir
+
+createNewArc :: ItemParams -> World -> Point2 -> Float
+    -> State StdGen [ArcStep]
+createNewArc arcparams w p dir = take (_arcNumber arcparams)
+    <$> unfoldrMID (_newArcStep arcparams arcparams w) (ArcStep p dir Nothing)
+
+updateArc :: ItemParams
+    -> World
+    -> Point2
+    -> Float
+    -> State StdGen [ArcStep]
+updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir Nothing) carc
+  where
+    carc = tail $ fromJust $ _currentArc ip
+
+zipArcs :: ItemParams
+    -> World
+    -> ArcStep
+    -> [ArcStep]
+    -> State StdGen [ArcStep]
+zipArcs ip w x (y:ys) = (x :) <$> do  
+    defaultnext <- _newArcStep ip ip w x
+    case defaultnext of
+        Nothing -> return []
+        Just z@(ArcStep _ _ (Just _)) -> return [z]
+        Just z -> do
+            p <- randInCirc 5
+            let csize = _arcSize ip
+                center = _asPos x +.+ csize *.* unitVectorAtAngle (_asDir x)
+                newp = _asPos y +.+ p
+                --newdir = argV $ newp -.- _asPos x
+                newdir = _asDir x
+            if dist newp center < csize
+                then zipArcs ip w (y & asPos .~ newp & asDir .~ newdir) ys
+                else zipArcs ip w z ys
+zipArcs ip w y _ = createNewArc ip w (_asPos y) (_asDir y)

src/Dodge/Tesla/Arc/Default.hs

@@ -0,0 +1,35 @@
+module Dodge.Tesla.Arc.Default where
+import Dodge.Data
+import RandomHelp
+import Geometry
+import Dodge.Base.Collide
+import LensHelp
+import Shape
+
+import Data.Maybe
+import Data.List (sortOn)
+import qualified Data.IntMap.Strict as IM
+
+defaultArcStep :: RandomGen g => ItemParams -> World -> ArcStep
+    -> State g (Maybe ArcStep)
+defaultArcStep _     _ (ArcStep _ _ (Just _)) = return Nothing
+defaultArcStep itparams w (ArcStep p dir _) = do
+    let csize = _arcSize itparams
+    --rot <- takeOne [pi/4,negate pi/4]
+    rot <- takeOne [0]
+    let center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
+    newp <- (center +.+) <$> randInCirc csize
+    let mcr = listToMaybe 
+            . sortOn (dist center . _crPos) 
+            . filter (\cr -> dist center (_crPos cr) < csize)
+            . IM.elems
+            $ _creatures w
+        mwl = listToMaybe
+            . sortOn (dist p . fst)
+            . mapMaybe (\ q -> sequence $ collidePointWallsFilterStream (const True) p (center +.+ q) w)
+                -- collidePointWallsWall and wlsnearpoint
+            $ polyCirc 6 csize
+        f (q,wl) = ArcStep q dir (Just $ Right wl)
+        g cr   = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (Just $ Left cr)
+    return . listToMaybe . sortOn (dist p . (^. asPos))
+        $ ArcStep newp dir Nothing : catMaybes [fmap f mwl,fmap g mcr]

src/Dodge/Tesla/Ball.hs

@@ -0,0 +1,6 @@
+module Dodge.Tesla.Ball where
+import Dodge.Data
+import Geometry
+
+makeTeslaBallAt :: Point2 -> World -> World
+makeTeslaBallAt _ = id

src/Dodge/Tesla/ItemParams.hs

@@ -0,0 +1,12 @@
+module Dodge.Tesla.ItemParams where
+import Dodge.Data
+import Dodge.Tesla.Arc.Default
+
+teslaParams :: ItemParams
+teslaParams = Arcing 
+    { _currentArc = Nothing
+    , _arcSize = 20
+    , _arcNumber = 10
+    , _newArcStep = defaultArcStep
+    , _previousArcEffect = NoPreviousArcEffect
+    }