Improve tesla weapon path

src/Dodge/Particle/Bullet/HitEffect.hs

@@ -1,5 +1,13 @@
 {- | Effects of bullets upon impact with walls or creatures.  -}
-module Dodge.Particle.Bullet.HitEffect where
+module Dodge.Particle.Bullet.HitEffect 
+    ( bulHitCr
+    , bulHitWall
+    , hvBulHitCr
+    , hvBulHitWall
+    , bulletDestroySpawn
+    , bulBounceArmCr
+    , bulBounceWall
+    ) where
 import Dodge.Data
 import Dodge.Particle.Spark
 import Dodge.Wall.Damage
@@ -7,7 +15,6 @@ import Dodge.WorldEvent
 import Dodge.Particle.Bullet.Spawn
 import Dodge.SoundLogic
 import Dodge.RandomHelp
-import Dodge.WorldEvent.Shockwave
 import Dodge.Creature.Property
 import Dodge.Wall.Reflect
 import Geometry
@@ -74,21 +81,6 @@ bulletHitSound p = soundMultiFrom [CrHitSound 0] p hit1S (Just 10)
 {- | Bounce off armoured creatures, otherwise do damage.  -}
 bulBounceArmCr :: Particle -> Point2 -> Creature -> World -> World
 bulBounceArmCr = crArmourSplit basicHitCr bounceArmour
-{- | Bullet pass through creatures.  -}
-bulPenCr' :: Particle -> Point2 -> Creature -> World -> World
-bulPenCr' bt p cr w = w
-    & instantParticles .:~ piercer
-    & bulletHitSound ep
-    & creatures . ix cid . crState . crDamage .++~
-        damageGamut 50 50 d1 sp p ep
-  where 
-    (d1,_)  = randomR (-0.7,0.7) $ _randGen w
-    cid = _crID cr
-    sp = head $ _ptTrail bt
-    ep = sp +.+ _ptVel bt
-    piercer = (aBulAt Nothing id (Just (_ptColor bt)) (Just cid) p (_ptVel bt) (_btDrag bt)
-                                      (_ptHitEff bt) (_ptWidth bt)
-              ) {_ptTimer = _ptTimer bt - 1}
 {- | Heavy bullet effects when hitting creature:
 piercing, blunt, twisting and pushback damage all applied.  -}
 hvBulHitCr :: Particle -> Point2 -> Creature -> World -> World
@@ -170,34 +162,6 @@ bulBounceWall bt p wl = damageWall (Damage Blunt 50 sp p ep NoDamageEffect) wl
 -- all projectiles in it are checked, so we cannot add to it as we accumulate over
 -- this list
 
-{- | Create flamelet on wall.  -}
-bulIncWall
-    :: Particle 
-    -> Point2   -- Impact point
-    -> Wall 
-    -> World 
-    -> World
-bulIncWall bt p wl = damageWall (Damage Blunt 50 sp p ep NoDamageEffect) wl 
-    . makeFlamelet pOut 20 reflectVel Nothing 3 20
-  where   
-    ep = sp +.+ _ptVel bt
-    sp = head $ _ptTrail bt
-    pOut = p +.+ squashNormalizeV (sp -.- p)
-    wallV = uncurry (-.-) (_wlLine wl)
-    reflectVel = squashNormalizeV $ reflectIn wallV (_ptVel bt)
-{- | Create a shockwave on wall-}
-bulConWall
-    :: Particle 
-    -> Point2   -- ^ Impact point
-    -> Wall 
-    -> World 
-    -> World
-bulConWall bt p wl = damageWall (Damage Blunt 10 sp p ep NoDamageEffect) wl .
-    makeShockwaveAt [] p 15 4 1 white
-  where   
-    ep = sp +.+ _ptVel bt
-    sp = head $ _ptTrail bt
-
 hvBulHitWall
     :: Particle 
     -> Point2   -- ^ Impact point

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
-