Add more wall reflection/randomisation

This commit is contained in:
2024-12-22 10:42:10 +00:00
parent 84821a1531
commit acba8de359
4 changed files with 122 additions and 79 deletions
+21 -8
View File
@@ -31,29 +31,42 @@ updateTeslaArc ::
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)
-- rdir = state (randomR (-0.7, 0.7)) <&> (+ ld)
rspeed = state (randomR (3, 6))
makeaspark = randSpark ELECTRICAL rspeed rcol rdir lp
makesparks = makeaspark . makeaspark . makeaspark
(lp, ld) = case last thearc of
ArcStep lp' ld' NothingID -> (lp', ld')
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', ld')
Just cr -> (lp' -.- (_crRad cr + 1) *.* unitVectorAtAngle ld', ld' + pi)
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', ld')
Just _ -> (lp' -.- 2 *.* unitVectorAtAngle ld', ld' + pi)
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)
damthings (ArcStep p dir crwl) = damageCrWlID (thedamage p dir) crwl
thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect
where
q = 5 *.* unitVectorAtAngle dir
randWallReflect :: RandomGen g => Float -> Wall -> State g Float
randWallReflect a wl = do
let (x,y) = _wlLine wl
outa = reflectAngle a 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