Improve tesla weapon path

src/Dodge/Particle/TeslaArc.hs

@@ -1,7 +1,10 @@
+{-# LANGUAGE TupleSections #-}
 module Dodge.Particle.TeslaArc
-    ( makeTeslaArcAt
+    ( aTeslaArcAt
+    , aTeslaArcAt'
     ) where
 import Dodge.Data
+import Dodge.Damage
 import Dodge.WorldEvent.Damage
 import Dodge.Base
 import Dodge.Zone
@@ -19,8 +22,18 @@ import Control.Monad.State
 import Data.Function (on)
 import Data.List
 import Data.Maybe
-makeTeslaArcAt :: Color -> Point2 -> Float -> Particle
-makeTeslaArcAt col pos dir = LinearParticle
+
+aTeslaArcAt' :: Color -> [(Point2,Float,Maybe (Either Creature Wall))] -> Particle
+aTeslaArcAt' col thearc = LinearParticle
+    { _ptPoints = map (^. _1) thearc
+    , _ptDraw = drawTeslaArc
+    , _ptUpdate = moveTeslaArc' thearc
+    , _ptTimer = 2
+    , _ptColor = brightX 100 1.5 col
+    }
+
+aTeslaArcAt :: Color -> Point2 -> Float -> Particle
+aTeslaArcAt col pos dir = LinearParticle
     { _ptPoints = [pos]
     , _ptDraw = drawTeslaArc
     , _ptUpdate = moveTeslaArc pos dir
@@ -34,6 +47,20 @@ drawTeslaArc pt = setLayer 1 $ pictures
     ]
   where
     ps = _ptPoints pt
+moveTeslaArc' :: [(Point2,Float,Maybe (Either Creature Wall))]
+    -> World
+    -> Particle
+    -> (World,Maybe Particle)
+moveTeslaArc' thearc w pt
+    | _ptTimer pt == 2  = (foldr damthings w thearc, Just $ pt & ptTimer -~ 1)
+    | _ptTimer pt < 1   = (w, Nothing)
+    | otherwise         = (w, Just $ pt & ptTimer -~ 1)
+  where
+    damthings (_,_,Nothing) = id
+    damthings (p,dir,Just crwl) = damageCrWall (thedamage p dir) crwl
+    thedamage p dir = Damage Electrical 5 (p -.- q) p (p +.+ q) NoDamageEffect
+      where
+        q = 5 *.* unitVectorAtAngle dir
 -- todo: fix electrical damage location
 moveTeslaArc 
     :: Point2   -- ^ Emmission position
@@ -43,8 +70,10 @@ moveTeslaArc
     -> (World, Maybe Particle)
 moveTeslaArc p d w pt
     | t == 2 = 
-        (foldr damCrs w hitCrs & randGen .~ g & colSpark 8 nc q2 (argV sv)
-             & damThingHitWith (\p1 p2 p3 -> Damage Electrical 50 p1 p2 p3 NoDamageEffect) 
+        ( foldr damCrs w hitCrs 
+            & randGen .~ g 
+            & colSpark 8 nc q2 (argV sv)
+            & damThingHitWith (\p1 p2 p3 -> Damage Electrical 50 p1 p2 p3 NoDamageEffect) 
                     q1 ((2 *.* q2) -.- q1) thHit
         , Just $ pt & ptTimer -~ 1 & ptPoints .~ ps'
         )
@@ -52,9 +81,9 @@ moveTeslaArc p d w pt
     | otherwise = (w , Just $ pt & ptTimer -~ 1)
  where 
     t = _ptTimer pt
-    ps = take 25 $ p : map f (crsLightChain p d 0 w)
+    ps = take 5 $ p : map f (crsLightChain p d 0 w)
     f (E3x1 cr) = _crPos cr
-    f (E3x2 p1) = p1
+    f (E3x2 (p1,_)) = p1
     f (E3x3 p1) = p1
     ps' = lightningMids d pers ps
     pers = evalState (sequence $ repeat $ randInCirc 5) $ _randGen w
@@ -85,7 +114,7 @@ lightningMids d1 (p:pers) (p1:p3:ps)
 lightningMids _ _ ps = ps
 {- Finds a list of hit things from a given point.
 'E3x1' objects are creatures, 'E3x2' objects are points on walls, 'E3x3' objects are points in space.  -}
-crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature Point2 Point2]
+crsLightChain :: Point2 -> Float -> Float -> World -> [Either3 Creature (Point2,Wall) Point2]
 crsLightChain p d wlAttract w = case crOrWallSensitive p d wlAttract w of
     E3x1 cr -> E3x1 cr : crsLightChain (_crPos cr) (argV (_crPos cr -.- p)) 
                                        (min 1 (wlAttract + 0.3)) w
@@ -103,29 +132,27 @@ crOrWallSensitive
     -> Float    -- ^ Direction (radians)
     -> Float    -- ^ Wall attraction parameter
     -> World 
-    -> Either3 Creature Point2 Point2
+    -> Either3 Creature (Point2,Wall) Point2
 crOrWallSensitive p dir wlAttract w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0))
     . listToMaybe 
     . sortBy (compare `on` g)
     $ catMaybes [cr,wlp]
   where 
     cr  = E3x1 <$> nearestCrInFront p dir 100 w
-    wlp = fmap E3x2 
+    wlp = fmap E3x2
         . listToMaybe
-        . sortBy (compare `on` dist p)
+        . sortBy (compare `on` dist p . fst)
         $ mapMaybe 
-            ( fmap fst
-            . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w)
+            ( (\p1 -> collidePointWallsWall p p1 $ wallsNearPoint p w)
             . (+.+) p
             . (\d -> rotateV d (V2 100 0))
             . (+ dir)
             . (* wlAttract)
             )
             [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8]
-    g (E3x2 p1)  = 100 + dist p p1 -- tweak makes it more likely to hit crs first
+    g (E3x2 (p1,_))  = 100 + dist p p1 -- tweak makes it more likely to hit crs first
     --g (E3x2 p1)  = dist p p1 - 100 -- tweak makes it more likely to hit walls first
     g (E3x1 cr1) = dist p $ _crPos cr1
     g _ = 0
     (arcLen,_) = randomR (25,50) $ _randGen w
 -- BUG: can hit crs through walls
-