From c443cc4372b3309facba6b3efc1021891be38114 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 31 Oct 2021 14:18:57 +0000 Subject: [PATCH] Generalise flame flicker, cleanup --- src/Dodge/WorldEvent/Cloud.hs | 7 +- src/Dodge/WorldEvent/Flash.hs | 14 +++ src/Dodge/WorldEvent/SpawnParticle.hs | 120 ++++---------------------- 3 files changed, 37 insertions(+), 104 deletions(-) diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index a1582acaf..87ff179bd 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ b/src/Dodge/WorldEvent/Cloud.hs @@ -13,6 +13,7 @@ import Geometry.Data import Picture import Control.Lens +import System.Random makeCloudAt :: (Cloud -> Picture) -- ^ draw function @@ -64,8 +65,10 @@ makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5 shellTrailCloud :: Point3 -> World -> World shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40 -makeFlamerSmokeAt :: Float -> Point3 -> World -> World -makeFlamerSmokeAt x = makeCloudAt (drawCloudWith 4 300 (greyN x)) 6 200 40 +makeFlamerSmokeAt :: Point3 -> World -> World +makeFlamerSmokeAt p w = makeCloudAt (drawCloudWith 4 300 (greyN x)) 6 200 40 p w + where + x = fst $ randomR (0.5,0.8) (_randGen w) spawnSmokeAtCursor :: World -> World spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 296701b37..302d5d02a 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -14,11 +14,13 @@ module Dodge.WorldEvent.Flash , laserGunFlashAt , teslaGunFlashAt , muzFlareAt + , flameFlicker ) where import Dodge.Data import Dodge.LightSources.Lamp import Dodge.WorldEvent.HelperParticle +import Dodge.Default import Picture import Geometry @@ -65,3 +67,15 @@ explosionFlashAt p = tempLightSources %~ (tLightTimedIntensity 20 150 intensityF sparkFlashAt :: Point2 -> World -> World sparkFlashAt _ = id + +flameFlicker :: Particle -> World -> World +flameFlicker pt + | _btTimer' pt `mod` 5 == 0 = tempLightSources %~ (theLight :) + | otherwise = id + where + V2 x y = _btPos' pt + theLight = defaultTLS + { _tlsPos = V3 x y 10 + , _tlsRad = 70 + , _tlsIntensity = V3 0.5 0 0 + } diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 064992e47..92c09c52c 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -11,7 +11,6 @@ module Dodge.WorldEvent.SpawnParticle import Dodge.Data import Dodge.Data.DamageType import Dodge.Data.SoundOrigin -import Dodge.Default import Dodge.Creature.State.Data import Dodge.Base import Dodge.Zone @@ -21,7 +20,7 @@ import Dodge.Picture import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.ThingsHit import Dodge.WorldEvent.Cloud ---import Dodge.WorldEvent.Flash +import Dodge.WorldEvent.Flash import Dodge.Particle.Bullet.Draw import Dodge.Particle.Bullet.Update import Dodge.SoundLogic @@ -49,7 +48,7 @@ aFlameParticle -> Particle aFlameParticle t pos vel maycid = PtZ { _ptDraw = drawFlame vel - , _ptUpdate = moveFlame vel + , _ptUpdate = moveFlame vel , _btVel' = vel , _btColor' = red , _btPos' = pos @@ -97,35 +96,24 @@ moveFlame -> Particle -> (World, Maybe Particle) moveFlame rotd w pt - | time <= 0 = (smokeGen w, Nothing) + | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of - ((_,E3x1 _):_) -> (doSound damcrs , mvPt') - (thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p) - _ -> (glare $ doSound damcrs , mvPt) + ((_,E3x1 _):_) -> (doSound damcrs , mvPt 0.7) + (thing@(p,E3x2 wl):_) -> (doSound . fst $ hiteff [thing] damcrs , rfl wl p) + _ -> (flameFlicker pt $ doSound damcrs , mvPt 0.98) where time = _btTimer' pt - doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2) -- . over worldEvents ((.) $ flameGlareAt ep) - glare - | time `mod` 5 == 0 - = tempLightSources %~ (theTLS :) - | otherwise = id - theTLS = defaultTLS - { _tlsPos = V3 x y 10 - , _tlsRad = 70 - , _tlsIntensity = V3 0.5 0 0 - } + doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2) sp@(V2 x y) = _btPos' pt vel = _btVel' pt ep = sp +.+ vel - mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep - , _btPassThrough' = Nothing - ,_btVel' = 0.98 *.* vel} - mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep - , _btPassThrough' = Nothing - ,_btVel' = 0.7 *.* vel} + mvPt speed = Just $ pt + { _btTimer' = time - 1 + , _btPos' = ep + , _btPassThrough' = Nothing + , _btVel' = speed *.* vel } damcrs = foldr (\cr -> fst . hiteff [(ep,E3x1 cr)]) w - $ filter closeCrs - $ IM.elems $ _creatures w + $ IM.filter closeCrs $ _creatures w closeCrs cr = dist ep (_crPos cr) < _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80)) + 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd) @@ -139,8 +127,6 @@ moveFlame rotd w pt pOut p = p +.+ safeNormalizeV (sp -.- p) reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel ) +.+ (0.2 *.* vel) - smokeCol = fst $ randomR (0.5,0.8) (_randGen w) - smokeGen = makeFlamerSmokeAt smokeCol (addZ 20 ep) makeFlameletTimed :: Point2 -- ^ Position @@ -152,12 +138,12 @@ makeFlameletTimed -> World -> World makeFlameletTimed (V2 x y) z vel maycid size time w = w - & randGen .~ g + & randGen .~ g & particles %~ (theFlamelet :) where theFlamelet = PtZ { _ptDraw = drawFlameletZ rot - , _ptUpdate = moveFlamelet + , _ptUpdate = moveFlamelet , _btVel' = vel , _btColor' = red , _btPos' = V2 x y @@ -188,7 +174,6 @@ drawFlameletZ rot pt = pictures time = _btTimer' pt piu = setDepth (z + 25) . uncurryV translate ep - -- . color (V4 2 (-0.5) (-0.5) 1) . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) (V4 2 0 0 1) (V4 2 0 0 0) ) @@ -215,53 +200,12 @@ drawFlameletZ rot pt = pictures s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 s2 = 0.5 * (sc + s1) -drawFlamelet - :: Float -- ^ Rotation - -> Particle - -> Picture -drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow] - where - sp = _btPos' pt - vel = _btVel' pt - ep = sp +.+ vel - size = _btWidth' pt - siz2 = size + 0.2 - time = _btTimer' pt - glow = setDepth 19 $ uncurryV translate ep - $ circleSolidCol (withAlpha 0 red) (withAlpha 0.05 red) 30 - piu = setDepth 20 - . uncurryV translate ep - . color (dark red) - . rotate (negate (rot - 0.1 * fromIntegral time)) - . scale s1 s1 - . polygon - $ rectNSWE siz2 (-siz2) (-siz2) siz2 - pi2 = setDepth 20.2 - . uncurryV translate ep - . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - orange (dark red) - ) - . rotate (negate (rot + 0.2 * fromIntegral time)) - . scale s2 s2 - . polygon - $ rectNSWE siz2 (-siz2) (-siz2) siz2 - pic = setDepth 20.4 - . uncurryV translate ep - . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) - white (dark red) - ) - . rotate (negate ( 0.1 * fromIntegral time + rot)) - . scale sc sc - $ polygon $ map toV2 [(-size,-size),(size,-size),(size,size),(-size,size)] - sc = (*) 2 $ log $ 1 + fromIntegral time / 20 - s1 = (*) 2 $ log $ 2 + fromIntegral time / 40 - s2 = 0.5 * (sc + s1) {- Update of a flamelet. Applies movement and attaches damage to nearby creatures. -} moveFlamelet :: World -> Particle -> (World, Maybe Particle) moveFlamelet w pt | _btTimer' pt <= 0 = ( w, Nothing) - | otherwise = (damcrs, mvPt) + | otherwise = (flameFlicker pt $ damcrs, mvPt) where sp = _btPos' pt vel = _btVel' pt @@ -298,7 +242,6 @@ makeGasCloud pos vel w = w , _clEffect = cloudPoisonDamage } (col, g) = runState (takeOne [green,yellow]) $ _randGen w - {- Attach poison cloud damage to creatures near cloud. -} @@ -307,7 +250,7 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 - doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1) + doDam cr = cr & crState . crDamage %~ (PoisonDam 1 :) makeTeslaArcAt :: Color -> Point2 -> Float -> Particle makeTeslaArcAt col pos dir = LinearParticle { _ptPoints = [pos] @@ -431,37 +374,11 @@ crOrWallSensitive p dir wlAttract w = g _ = 0 (arcLen,_) = randomR (25,50) $ _randGen w -- BUG: can hit crs through walls -{- Finds whether a creature or wall is in front of a given point and direction. -Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'. -} -crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2 -crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (V2 arcLen 0)) - $ listToMaybe $ sortBy (compare `on` g) - $ catMaybes [cr,wlp] - where - cr = E3x1 <$> nearestCrInFront p dir 100 w - wlp = fmap E3x2 - $ listToMaybe - $ sortBy (compare `on` dist p) - $ mapMaybe - ( fmap fst - . (\p1 -> reflectPointWalls p p1 $ wallsNearPoint p w) - . (+.+) p - . (\d -> rotateV d (V2 100 0)) - . (+) dir - ) - [-(3*pi/8),-pi/4,-pi/8,0,pi/8,pi/4,3*pi/8] - --[-pi/4,-pi/8,0,pi/8,pi/4] - g (E3x2 p1) = 100 + dist p p1 -- tweak makes it more likely to hit crs first - --g (E3x2 p1) = dist p p1 - 100 -- tweak makes it more likely to hit walls first - g (E3x1 cr1) = dist p $ _crPos cr1 - g _ = 0 - (arcLen,_) = randomR (25,50) $ _randGen w -- | Create a spark. -- If the spark is created by another Particle, it cannot be directly added to -- the list, hence the redirect through worldEvents. createSparkCol :: Int -> Color -> Point2 -> Float -> World -> World -createSparkCol time col pos dir w - = w & worldEvents %~ ( over particles (spark :) . ) +createSparkCol time col pos dir = worldEvents %~ ( over particles (spark :) . ) where spark = BulletPt { _ptDraw = drawBul @@ -479,4 +396,3 @@ createSparkCol time col pos dir w where sp = head (_btTrail' bt) ep = sp +.+ _btVel' bt -