From 632deb74867286ea5bfc60fa8b5b3bccba8eab37 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 22 Dec 2024 14:50:08 +0000 Subject: [PATCH] Cleanup tesla arcs --- src/Dodge/ArcStep.hs | 12 ----- src/Dodge/Tesla/Arc.hs | 83 ++++++++++++++++++++++++---------- src/Dodge/Tesla/Arc/Default.hs | 44 ------------------ tags | 17 +++---- 4 files changed, 69 insertions(+), 87 deletions(-) delete mode 100644 src/Dodge/ArcStep.hs delete mode 100644 src/Dodge/Tesla/Arc/Default.hs diff --git a/src/Dodge/ArcStep.hs b/src/Dodge/ArcStep.hs deleted file mode 100644 index 4a88b7d89..000000000 --- a/src/Dodge/ArcStep.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Tesla/Arc.hs b/src/Dodge/Tesla/Arc.hs index 9e6d89eba..1dc03d11e 100644 --- a/src/Dodge/Tesla/Arc.hs +++ b/src/Dodge/Tesla/Arc.hs @@ -4,45 +4,40 @@ 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 - -aTeslaArcAt :: Color -> [ArcStep] -> TeslaArc -aTeslaArcAt col thearc = - TeslaArc - { _taPoints = map (^. asPos) thearc - , _taArcSteps = thearc - , _taTimer = 2 - , _taColor = brightX 100 1.5 col - } +import Shape updateTeslaArc :: World -> TeslaArc -> (World, Maybe TeslaArc) updateTeslaArc w pt - | _taTimer pt == 2 = (makesparks $ foldl' (flip damthings) w thearc - , Just $ pt & taTimer -~ 1) + | _taTimer pt == 2 = + ( 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 - rp x = randPeakedParam 2 (x - 0.7) x (x +0.7) + rp x = randPeakedParam 2 (x - 0.7) x (x + 0.7) (lp, rdir) = case last thearc of ArcStep lp' ld' NothingID -> (lp', rp ld') ArcStep lp' ld' (CrID crid) -> case w ^? cWorld . lWorld . creatures . ix crid of @@ -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 -> (lp' -.- 2 *.* unitVectorAtAngle ld' --- , uncurry (reflectAngle ld') (_wlLine wl)) - , randWallReflect ld' wl) + Just wl -> + ( lp' -.- 2 *.* unitVectorAtAngle ld' + , 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 @@ -61,16 +56,22 @@ updateTeslaArc w pt randWallReflect :: RandomGen g => Float -> Wall -> State g Float randWallReflect a wl = do - let (x,y) = _wlLine wl + let (x, y) = _wlLine wl outa = reflectAngle a x y - a1 = nearestAngleRep outa $ argV (x-y) + a1 = nearestAngleRep outa $ argV (x - y) a2 = if a1 < outa then a1 + pi else a1 - pi randPeaked a1 outa a2 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] diff --git a/src/Dodge/Tesla/Arc/Default.hs b/src/Dodge/Tesla/Arc/Default.hs deleted file mode 100644 index 0072ef38d..000000000 --- a/src/Dodge/Tesla/Arc/Default.hs +++ /dev/null @@ -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] diff --git a/tags b/tags index 7dca9836c..db062b806 100644 --- a/tags +++ b/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