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

Start simplifying tesla arcs

Browse Source
This commit is contained in:
justin
2025-01-09 11:01:17 +00:00
parent c355fe4f5f
commit 5fb71cec39
6 changed files with 35 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Tesla.hs
+23 -23
View File
@@ -20,35 +20,35 @@ import Picture
import RandomHelp
import Shape
updateTeslaArc ::
World ->
TeslaArc ->
(World, Maybe TeslaArc)
updateTeslaArc :: World -> TeslaArc -> (World, Maybe TeslaArc)
updateTeslaArc w pt
| _taTimer pt == 2 =
( makesparks $ foldl' (flip damthings) w thearc
, Just $ pt & taTimer -~ 1
)
| _taTimer pt < 0 = (w, Nothing)
| otherwise = (w, Just $ pt & taTimer -~ 1)
| _taTimer pt >= 0 = (w, Just $ pt & taTimer -~ 1)
| otherwise = (w, Nothing)
where
thearc = _taArcSteps pt
rcol = brightX 100 1.5 <$> takeOne [white, azure, blue, cyan]
rspeed = state (randomR (3, 6))
makeaspark = randSpark ELECTRICAL rspeed rcol rdir lp
makeaspark =
randSpark
ELECTRICAL
(state (randomR (3, 6)))
(brightX 100 1.5 <$> takeOne [white, azure, blue, cyan])
rdir
lp
makesparks = makeaspark . makeaspark . makeaspark
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
Nothing -> (lp', rp ld')
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 wl ->
( lp' -.- 2 *.* unitVectorAtAngle ld'
, randWallReflect ld' wl
)
(lp, rdir)
| ArcStep lp' ld' (CrID crid) <- last thearc
, Just cr <- w ^? cWorld . lWorld . creatures . ix crid =
(lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', rp $ ld' + pi)
| ArcStep lp' ld' (WlID wlid) <- last thearc
, Just wl <- w ^? cWorld . lWorld . walls . ix wlid =
( lp' -.- 2 *.* unitVectorAtAngle ld'
, randWallReflect ld' wl
)
| ArcStep lp' ld' _ <- last thearc = (lp', rp ld')
damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect
where
@@ -67,8 +67,8 @@ makeTeslaArc ip pos dir w =
( w & randGen .~ g
& cWorld . lWorld . teslaArcs
.:~ TeslaArc
{ _taPoints = map (^. asPos) newarc
, _taArcSteps = newarc
--{ _taPoints = map (^. asPos) newarc
{ _taArcSteps = newarc
, _taTimer = 2
, _taColor = brightX 100 1.5 col
}
@@ -97,7 +97,7 @@ updateArc ::
updateArc ip w p dir = take (_arcNumber ip) <$> zipArcs ip w (ArcStep p dir NothingID) carc
where
carc = case _currentArc ip of
(_:xs) -> xs
(_ : xs) -> xs
[] -> [] -- tail $ _currentArc ip
zipArcs ::