Improve tesla weapon path

src/Dodge/Item/Weapon/BatteryGuns.hs

@@ -26,12 +26,15 @@ import Picture
 import Shape
 import ShapePicture
 import LensHelp
+import Dodge.RandomHelp
+import MonadHelp
 
---import Data.List
---import Data.Bifunctor
+import Data.Maybe
+import Data.List (sortOn)
 import System.Random
 --import Data.Tuple
 import qualified Data.IntMap.Strict as IM
+import Control.Monad.State
 sparkGun :: Item
 sparkGun = teslaGun
     & itName .~ "SPARKGUN"
@@ -45,7 +48,7 @@ teslaGun = defaultGun
         , _ammoLoaded = 200
         , _reloadTime = 80
         }
-    , _itUse = ruseInstant (const aTeslaArc) NoHammer
+    , _itUse = ruseInstant shootTeslaArc NoHammer
         [ ammoCheckI
         , withTempLight 1 100 (V3 0 0 1)
         , withSoundForI elecCrackleS 1
@@ -62,6 +65,7 @@ teslaGun = defaultGun
             }
         , _dimSPic = teslaGunPic
         }
+    , _itParams = Arcing {_currentArc = Nothing}
     }
 teslaGunPic :: Item -> SPic
 teslaGunPic _ = noPic $ colorSH blue $
@@ -79,7 +83,7 @@ lasGun = defaultAutoGun
         , _ammoLoaded = 200
         , _reloadTime = 80
         }
-    , _itUse = ruseInstant aLaser NoHammer
+    , _itUse = ruseInstant shootLaser NoHammer
         [ ammoCheckI
         , withTempLight 1 100 (V3 1 1 0)
         , withSoundForI tone440sawtoothquietS 2
@@ -189,21 +193,65 @@ tractorGunPic it =
     amFrac = fractionLoadedAmmo it
     col = brightX 2 1.5 $ mixColors amFrac (1-amFrac) green red
 
-aTeslaArc :: Creature -> World -> World
-aTeslaArc cr w = set randGen g w
-    & particles .:~ makeTeslaArcAt col pos dir
+-- | assumes that the item is held
+shootTeslaArc :: Item -> Creature -> World -> World
+shootTeslaArc it cr w = w & randGen .~ g
+    & particles .:~ aTeslaArcAt' col newarc
+    & creatures . ix (_crID cr) . crInv . ix (_crInvSel cr) . itParams . currentArc ?~ newarc
   where 
-    pos = _crPos cr +.+ (_crRad cr +1) *.* unitVectorAtAngle dir
+    pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
     dir = _crDir cr
-    (colid,g) = randomR (0::Int,3) $ _randGen w
-    col = chooseColor colid
-    chooseColor 0 = white
-    chooseColor 1 = azure
-    chooseColor 2 = blue
-    chooseColor _ = cyan
+    (col,g) = takeOne [white,azure,blue,cyan] & runState $ _randGen w
+    newarc = createArc (_currentArc (_itParams it)) w pos dir & evalState $ _randGen w
 
-aLaser :: Item -> Creature -> World -> World
-aLaser it cr = particles .:~ lasRayAt phasev pos dir
+createArc :: RandomGen g
+    => Maybe [(Point2,Float,Maybe (Either Creature Wall))]
+    -> World
+    -> Point2
+    -> Float
+    -> State g [(Point2,Float,Maybe (Either Creature Wall))]
+createArc Nothing w p dir = createNewArc w p dir
+createArc (Just thearc) w p dir = updateArc thearc w p dir
+
+createNewArc :: RandomGen g => World -> Point2 -> Float
+    -> State g [(Point2,Float,Maybe (Either Creature Wall))]
+createNewArc w p dir = take 10
+    <$> unfoldrMID (newArcStep w) (p,dir,Nothing)
+
+newArcStep :: RandomGen g => World -> (Point2,Float,Maybe (Either Creature Wall))
+    -> State g (Maybe (Point2,Float,Maybe (Either Creature Wall)))
+newArcStep _ (_,_,Just _) = return Nothing
+newArcStep w (p,dir,_) = do
+    rot <- takeOne [pi/4,negate pi/4]
+    let csize = 10
+        center = csize *.* rotateV rot (unitVectorAtAngle dir) +.+ p
+    newp <- (center +.+) <$> randInCirc csize
+    let mcr = listToMaybe 
+            . sortOn (dist p . _crPos) 
+            . filter (\cr -> dist p (_crPos cr) < csize)
+            . IM.elems
+            $ _creatures w
+        wlsnearpoint = wallsNearPoint p w
+        mwl = listToMaybe
+            . sortOn (dist p . fst)
+            . mapMaybe (\ q -> collidePointWallsWall p q wlsnearpoint)
+            . map (center +.+)
+            $ polyCirc 6 csize
+        f (q,wl) = (q,dir,Just $ Right wl)
+        g (cr)   = (_crPos cr +.+ 10 *.* unitVectorAtAngle dir, dir,Just $ Left cr)
+    return . listToMaybe . sortOn (dist p . (^. _1)) 
+        $ (newp,dir,Nothing) : catMaybes [fmap f mwl,fmap g mcr]
+
+updateArc :: RandomGen g 
+    => [(Point2,Float,Maybe (Either Creature Wall))]
+    -> World
+    -> Point2
+    -> Float
+    -> State g [(Point2,Float,Maybe (Either Creature Wall))]
+updateArc _ w p dir = createNewArc w p dir
+
+shootLaser :: Item -> Creature -> World -> World
+shootLaser it cr = particles .:~ lasRayAt phasev pos dir
   where 
     pos = _crPos cr +.+ aimingMuzzlePos cr it *.* unitVectorAtAngle dir
     dir = _crDir cr
@@ -221,7 +269,7 @@ mvLaser :: Float    -- ^ Phase velocity, controls deflection through windows
     -> Particle 
     -> (World, Maybe Particle)
 mvLaser phasev pos dir w pt
-    = ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 19 p1 p2 p3 NoDamageEffect) pos xp thHit w
+    = ( damThingHitWith (\p1 p2 p3 -> Damage Lasering 11 p1 p2 p3 NoDamageEffect) pos xp thHit w
       , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
       )
   where

src/Dodge/Item/Weapon/SprayGuns.hs

@@ -145,7 +145,7 @@ flameThrower = defaultAutoGun
 --    , _itFloorPict = flamerPic
 --    , _itZoom       = defaultItZoom
     , _itAttachment = NoItAttachment
-    , _itParams = Sprayer' 
+    , _itParams = Sprayer
         { _sprayNozzles = 
             [ Nozzle 
                 { _nzPressure = 4