justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup tesla arcs

Browse Source
This commit is contained in:
justin
2024-12-22 14:50:08 +00:00
parent acba8de359
commit 632deb7486
4 changed files with 69 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/ArcStep.hs
-12
View File
@@ -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
+60 -23
View File
@@ -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]
src/Dodge/Tesla/Arc/Default.hs
-44
View File
@@ -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
+9 -8
View File
@@ -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