Cleanup tesla arcs

src/Dodge/ArcStep.hs

@@ -1,12 +0,0 @@
-module Dodge.ArcStep where
-
-import Control.Monad.State
-import Dodge.Data.ArcStep
-import Dodge.Data.World
-import Dodge.Tesla.Arc.Default
-import System.Random
-
-doStep :: NextArcStep -> ItemParams -> World -> ArcStep -> State StdGen (Maybe ArcStep)
-doStep nas = case nas of
-    DefaultArcStep -> defaultArcStep
-    EndArc -> const $ const $ const $ return Nothing

src/Dodge/Tesla/Arc.hs

@@ -4,41 +4,36 @@ module Dodge.Tesla.Arc (
 ) where
 
 import Data.Foldable
+import Data.List (sortOn)
 import Data.Maybe
-import Dodge.ArcStep
+import Dodge.Base.Collide
 import Dodge.Damage
 import Dodge.Data.ArcStep
 import Dodge.Data.CrWlID
 import Dodge.Data.World
 import Dodge.Spark
 import Geometry
+import qualified IntMapHelp as IM
 import LensHelp
 import MonadHelp
 import Picture
 import RandomHelp
-
+import Shape
-aTeslaArcAt :: Color -> [ArcStep] -> TeslaArc
-aTeslaArcAt col thearc =
-    TeslaArc
-        { _taPoints = map (^. asPos) thearc
-        , _taArcSteps = thearc
-        , _taTimer = 2
-        , _taColor = brightX 100 1.5 col
-        }
 
 updateTeslaArc ::
     World ->
     TeslaArc ->
     (World, Maybe TeslaArc)
 updateTeslaArc w pt
-    | _taTimer pt == 2 = (makesparks $ foldl' (flip damthings) w thearc
+    | _taTimer pt == 2 =
-        , Just $ pt & taTimer -~ 1)
+        ( makesparks $ foldl' (flip damthings) w thearc
+        , Just $ pt & taTimer -~ 1
+        )
     | _taTimer pt < 1 = (w, Nothing)
     | otherwise = (w, Just $ pt & taTimer -~ 1)
   where
     thearc = _taArcSteps pt
     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
@@ -50,10 +45,10 @@ updateTeslaArc w pt
             Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', rp $ ld' + pi)
         ArcStep lp' ld' (WlID wlid) -> case w ^? cWorld . lWorld . walls . ix wlid of
             Nothing -> (lp', rp ld')
-            --Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
+            Just wl ->
-            Just wl -> (lp' -.- 2 *.* unitVectorAtAngle ld'
+                ( lp' -.- 2 *.* unitVectorAtAngle ld'
---                , uncurry (reflectAngle ld') (_wlLine wl))
+                , randWallReflect ld' wl
-                , randWallReflect ld' wl)
+                )
     damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
     thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect
       where
@@ -70,7 +65,13 @@ randWallReflect a wl = do
 makeTeslaArc :: ItemParams -> Point2 -> Float -> World -> (World, ItemParams)
 makeTeslaArc ip pos dir w =
     ( w & randGen .~ g
-        & cWorld . lWorld . teslaArcs .:~ aTeslaArcAt col newarc
+        & cWorld . lWorld . teslaArcs
+            .:~ TeslaArc
+                { _taPoints = map (^. asPos) newarc
+                , _taArcSteps = newarc
+                , _taTimer = 2
+                , _taColor = brightX 100 1.5 col
+                }
     , ip & currentArc ?~ newarc
     )
   where
@@ -94,7 +95,7 @@ createNewArc ::
     State StdGen [ArcStep]
 createNewArc arcparams w p dir =
     take (_arcNumber arcparams)
-        <$> unfoldrMID (doStep (_newArcStep arcparams) arcparams w) (ArcStep p dir NothingID)
+        <$> unfoldrMID (doArcStep (_newArcStep arcparams) arcparams w) (ArcStep p dir NothingID)
 
 updateArc ::
     ItemParams ->
@@ -114,7 +115,7 @@ zipArcs ::
     State StdGen [ArcStep]
 zipArcs ip w x (y : ys) =
     (x :) <$> do
-        defaultnext <- doStep (_newArcStep ip) ip w x
+        defaultnext <- doArcStep (_newArcStep ip) ip w x
         case defaultnext of
             Nothing -> return []
             Just z@(ArcStep _ _ (CrID _)) -> return [z]
@@ -130,3 +131,39 @@ zipArcs ip w x (y : ys) =
                     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)
+
+doArcStep :: NextArcStep -> ItemParams -> World -> ArcStep -> State StdGen (Maybe ArcStep)
+doArcStep nas = case nas of
+    DefaultArcStep -> defaultArcStep
+    EndArc -> const $ const $ const $ return Nothing
+
+defaultArcStep ::
+    RandomGen g =>
+    ItemParams ->
+    World ->
+    ArcStep ->
+    State g (Maybe ArcStep)
+defaultArcStep _ _ (ArcStep _ _ (CrID _)) = return Nothing
+defaultArcStep _ _ (ArcStep _ _ (WlID _)) = 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
+                $ w ^. cWorld . lWorld . creatures --_creatures (_cWorld w)
+        mwl =
+            listToMaybe
+                . sortOn (dist p . fst)
+                . mapMaybe (\q -> sequence $ collidePointWallsFilter (const True) p (center +.+ q) w)
+                -- collidePointWallsWall and wlsnearpoint
+                $ polyCirc 6 csize
+        f (q, wl) = ArcStep q dir (WlID $ _wlID wl)
+        g cr = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (CrID $ _crID cr)
+    return . listToMaybe . sortOn (dist p . (^. asPos)) $
+        ArcStep newp dir NothingID : catMaybes [fmap f mwl, fmap g mcr]

src/Dodge/Tesla/Arc/Default.hs

@@ -1,44 +0,0 @@
-module Dodge.Tesla.Arc.Default where
-
-import Dodge.Data.CrWlID
-import Data.List (sortOn)
-import Data.Maybe
-import Dodge.Base.Collide
-import Dodge.Data.ArcStep
-import Dodge.Data.World
-import Geometry
-import qualified IntMapHelp as IM
-import LensHelp
-import RandomHelp
-import Shape
-
-defaultArcStep ::
-    RandomGen g =>
-    ItemParams ->
-    World ->
-    ArcStep ->
-    State g (Maybe ArcStep)
-defaultArcStep _ _ (ArcStep _ _ (CrID _)) = return Nothing
-defaultArcStep _ _ (ArcStep _ _ (WlID _)) = 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
-                $ w ^. cWorld . lWorld . creatures --_creatures (_cWorld w)
-        mwl =
-            listToMaybe
-                . sortOn (dist p . fst)
-                . mapMaybe (\q -> sequence $ collidePointWallsFilter (const True) p (center +.+ q) w)
-                -- collidePointWallsWall and wlsnearpoint
-                $ polyCirc 6 csize
-        f (q, wl) = ArcStep q dir (WlID $ _wlID wl)
-        g cr = ArcStep (_crPos cr +.+ csize *.* unitVectorAtAngle dir) dir (CrID $ _crID cr)
-    return . listToMaybe . sortOn (dist p . (^. asPos)) $
-        ArcStep newp dir NothingID : catMaybes [fmap f mwl, fmap g mcr]

tags

@@ -3260,7 +3260,6 @@ aRadarPulse	src/Dodge/RadarSweep.hs	15;"	f
 aShape	src/Dodge/Placement/Instance/LightSource.hs	107;"	f
 aSound	src/Dodge/SoundLogic.hs	68;"	f
 aStaticBall	src/Dodge/WorldEvent/SpawnParticle.hs	41;"	f
-aTeslaArcAt	src/Dodge/Tesla/Arc.hs	20;"	f
 aTreeStrut	src/Dodge/Tree/GenerateStructure.hs	42;"	f
 accessTerminal	src/Dodge/WorldEffect.hs	48;"	f
 activeTargetCursorPic	src/Dodge/Targeting/Draw.hs	24;"	f
@@ -3693,7 +3692,7 @@ crZoneSize	src/Dodge/Zoning/Creature.hs	39;"	f
 craftInfo	src/Dodge/Item/Info.hs	123;"	f
 craftItemSPic	src/Dodge/Item/Draw/SPic.hs	44;"	f
 crankSlowS	src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs	434;"	f
-createArc	src/Dodge/Tesla/Arc.hs	78;"	f
+createArc	src/Dodge/Tesla/Arc.hs	81;"	f
 createBarrelSpark	src/Dodge/Spark.hs	44;"	f
 createFlIt	src/Dodge/Placement/PlaceSpot.hs	180;"	f
 createForceField	src/Dodge/ForceField.hs	7;"	f
@@ -3701,7 +3700,7 @@ createGas	src/Dodge/Gas.hs	8;"	f
 createHeadLamp	src/Dodge/Euse.hs	135;"	f
 createItemYou	src/Dodge/Inventory/Add.hs	95;"	f
 createLightMap	src/Render.hs	26;"	f
-createNewArc	src/Dodge/Tesla/Arc.hs	87;"	f
+createNewArc	src/Dodge/Tesla/Arc.hs	90;"	f
 createPathGrid	src/Dodge/Room/Path.hs	21;"	f
 createProjectile	src/Dodge/HeldUse.hs	575;"	f
 createShell	src/Dodge/Projectile/Create.hs	19;"	f
@@ -3817,6 +3816,7 @@ defaultAimMvType	src/Dodge/Default/Creature.hs	116;"	f
 defaultAimParams	src/Dodge/Default/Item/Use/AimParams.hs	9;"	f
 defaultAimingCrit	src/Dodge/Default/Creature.hs	125;"	f
 defaultApplyDamage	src/Dodge/Creature/Damage.hs	20;"	f
+defaultArcStep	src/Dodge/Tesla/Arc.hs	140;"	f
 defaultArcStep	src/Dodge/Tesla/Arc/Default.hs	15;"	f
 defaultAudition	src/Dodge/Default/Creature.hs	93;"	f
 defaultAutoWall	src/Dodge/Default/Door.hs	15;"	f
@@ -3936,6 +3936,7 @@ divideLineOddNumPoints	src/Geometry.hs	278;"	f
 doAfterPlacement	src/Dodge/Layout.hs	86;"	f
 doAfterPlacements	src/Dodge/Layout.hs	83;"	f
 doAnyEquipmentEffect	src/Dodge/Creature/State.hs	180;"	f
+doArcStep	src/Dodge/Tesla/Arc.hs	135;"	f
 doBackspace	src/Dodge/Update/Input/Text.hs	31;"	f
 doBlBl	src/Dodge/WorldEffect.hs	90;"	f
 doBlSh	src/Dodge/Block/Draw.hs	14;"	f
@@ -4801,7 +4802,7 @@ makeSwitch	src/Dodge/LevelGen/Switch.hs	52;"	f
 makeSwitchSPic	src/Dodge/LevelGen/Switch.hs	40;"	f
 makeTermLine	src/Dodge/Terminal.hs	120;"	f
 makeTermPara	src/Dodge/Terminal.hs	123;"	f
-makeTeslaArc	src/Dodge/Tesla/Arc.hs	68;"	f
+makeTeslaArc	src/Dodge/Tesla/Arc.hs	65;"	f
 makeTeslaBallAt	src/Dodge/Tesla/Ball.hs	6;"	f
 makeTeslaExplosionAt	src/Dodge/WorldEvent/Explosion.hs	40;"	f
 makeThickSmokeAt	src/Dodge/WorldEvent/Cloud.hs	54;"	f
@@ -5298,7 +5299,7 @@ randPeaked	src/RandomHelp.hs	133;"	f
 randPeakedParam	src/RandomHelp.hs	125;"	f
 randProb	src/RandomHelp.hs	68;"	f
 randSpark	src/Dodge/Spark.hs	74;"	f
-randWallReflect	src/Dodge/Tesla/Arc.hs	60;"	f
+randWallReflect	src/Dodge/Tesla/Arc.hs	57;"	f
 randomChallenges	src/Dodge/Room/Start.hs	62;"	f
 randomCompass	src/Dodge/Layout.hs	59;"	f
 randomFourCornerRoom	src/Dodge/Room/Procedural.hs	266;"	f
@@ -6013,7 +6014,7 @@ unusedSpotNearInLink	src/Dodge/PlacementSpot.hs	191;"	f
 upHammer	src/Dodge/Default.hs	76;"	f
 upProjectile	src/Dodge/Projectile/Update.hs	26;"	f
 updateAllNodes	src/TreeHelp.hs	85;"	f
-updateArc	src/Dodge/Tesla/Arc.hs	97;"	f
+updateArc	src/Dodge/Tesla/Arc.hs	100;"	f
 updateAttachedItems	src/Dodge/Creature/State.hs	256;"	f
 updateBackspaceRegex	src/Dodge/Update/Input/InGame.hs	455;"	f
 updateBarrel	src/Dodge/Barreloid.hs	45;"	f
@@ -6108,7 +6109,7 @@ updateSounds	src/Sound.hs	66;"	f
 updateSpark	src/Dodge/Spark.hs	19;"	f
 updateSparks	src/Dodge/Update.hs	564;"	f
 updateTempLightSource	src/Dodge/LightSource/Update.hs	7;"	f
-updateTeslaArc	src/Dodge/Tesla/Arc.hs	29;"	f
+updateTeslaArc	src/Dodge/Tesla/Arc.hs	23;"	f
 updateTeslaArcs	src/Dodge/Update.hs	546;"	f
 updateTractorBeam	src/Dodge/TractorBeam/Update.hs	9;"	f
 updateTractorBeams	src/Dodge/Update.hs	549;"	f
@@ -6289,7 +6290,7 @@ zConnect	src/Dodge/Render/Connectors.hs	17;"	f
 zConnectCol	src/Dodge/Render/Connectors.hs	28;"	f
 zConnectColMidX	src/Dodge/Render/Connectors.hs	31;"	f
 zeroZ	src/Geometry/Vector.hs	8;"	f
-zipArcs	src/Dodge/Tesla/Arc.hs	107;"	f
+zipArcs	src/Dodge/Tesla/Arc.hs	110;"	f
 zipCount	src/Dodge/Tree/Shift.hs	129;"	f
 zipCountDown	src/Dodge/Room/Procedural.hs	118;"	f
 zipWithDefaults	src/Dodge/Item/Display.hs	22;"	f