Move flame into its own datatype

src/Dodge/Beam.hs

@@ -1,22 +1,21 @@
 module Dodge.Beam where
 import Dodge.Data
-import Dodge.Particle.Flame
-import Dodge.Particle.TeslaArc
+import Dodge.Flame
+import Dodge.Tesla.Arc
 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 RandomHelp
 --import Dodge.Zone
-import Dodge.Base.Collide
-import Shape
+--import Dodge.Base.Collide
+--import Shape
 
-import Data.List (sortOn)
-import MonadHelp
+--import Data.List (sortOn)
+--import MonadHelp
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 
@@ -81,81 +80,3 @@ drawLaser pt =
   where
     col = _ptColor pt
     ps = _ptPoints pt
-
-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)
-
-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]
-
-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)