From 23022d85a1326e9231390061a8bc88ccab6dca5e Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 10 Jul 2022 12:38:32 +0100 Subject: [PATCH] Move radar blips into own grouping, work on data-ifying particles --- src/Dodge/Data.hs | 49 +++---- src/Dodge/Data/RadarBlip.hs | 16 +++ src/Dodge/Item/Weapon/Decoration.hs | 5 +- src/Dodge/Item/Weapon/ExtraEffect.hs | 4 +- src/Dodge/Item/Weapon/UseEffect.hs | 1 + src/Dodge/Particle/Draw.hs | 200 ++++++++++++++++++++++++++ src/Dodge/Particle/TeslaArc.hs | 2 +- src/Dodge/RadarBlip.hs | 23 +++ src/Dodge/WorldEvent/Flash.hs | 14 +- src/Dodge/WorldEvent/SpawnParticle.hs | 8 +- 10 files changed, 290 insertions(+), 32 deletions(-) create mode 100644 src/Dodge/Data/RadarBlip.hs create mode 100644 src/Dodge/Particle/Draw.hs create mode 100644 src/Dodge/RadarBlip.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 24f7fbabd..02ddfd7c7 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -635,16 +635,17 @@ data BeamType {- Objects without ids. Update themselves, perhaps with side effects. -} data Particle - = Particle - { _ptDraw :: Particle -> Picture - , _ptUpdate :: World -> Particle -> (World, Maybe Particle) - } - | RadarCircleParticle +-- = Particle +-- { _ptDraw :: Particle -> Picture +-- , _ptUpdate :: World -> Particle -> (World, Maybe Particle) +-- } + = RadarCircleParticle { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) , _ptTimer :: Int , _ptRad :: Float , _ptPos :: Point2 + , _ptColor :: Color } | LaserParticle { _ptDraw :: Particle -> Picture @@ -668,13 +669,13 @@ data Particle , _ptPoints :: [Point2] , _ptColor :: Color } - | LinearParticle - { _ptDraw :: Particle -> Picture - , _ptUpdate :: World -> Particle -> (World, Maybe Particle) - , _ptPoints :: [Point2] - , _ptTimer :: Int - , _ptColor :: Color - } +-- | LinearParticle +-- { _ptDraw :: Particle -> Picture +-- , _ptUpdate :: World -> Particle -> (World, Maybe Particle) +-- , _ptPoints :: [Point2] +-- , _ptTimer :: Int +-- , _ptColor :: Color +-- } | BulletPt { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) @@ -739,18 +740,18 @@ data Particle , _ptAlpha :: Float , _ptTran3 :: Point3 } - | PtZ - { _ptDraw :: Particle -> Picture - , _ptUpdate :: World -> Particle -> (World, Maybe Particle) - , _ptVel :: Point2 - , _ptColor :: Color - , _ptPos :: Point2 - , _ptCrIgnore :: Maybe Int - , _ptWidth :: Float - , _ptTimer :: Int - , _ptHitEff :: HitEffect - , _ptZ :: Float - } +-- | PtZ +-- { _ptDraw :: Particle -> Picture +-- , _ptUpdate :: World -> Particle -> (World, Maybe Particle) +-- , _ptVel :: Point2 +-- , _ptColor :: Color +-- , _ptPos :: Point2 +-- , _ptCrIgnore :: Maybe Int +-- , _ptWidth :: Float +-- , _ptTimer :: Int +-- , _ptHitEff :: HitEffect +-- , _ptZ :: Float +-- } | Shockwave { _ptDraw :: Particle -> Picture , _ptUpdate :: World -> Particle -> (World, Maybe Particle) diff --git a/src/Dodge/Data/RadarBlip.hs b/src/Dodge/Data/RadarBlip.hs new file mode 100644 index 000000000..b4bfaefe2 --- /dev/null +++ b/src/Dodge/Data/RadarBlip.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.RadarBlip where +import Color +import Geometry +import Control.Lens + +data RadarBlip = RadarBlip + { _rbColor :: Color + , _rbTime :: Int + , _rbMaxTime :: Int + , _rbRad :: Float + , _rbPos :: Point2 + } + +makeLenses ''RadarBlip diff --git a/src/Dodge/Item/Weapon/Decoration.hs b/src/Dodge/Item/Weapon/Decoration.hs index d393f9d49..ecbd9074d 100644 --- a/src/Dodge/Item/Weapon/Decoration.hs +++ b/src/Dodge/Item/Weapon/Decoration.hs @@ -14,14 +14,17 @@ makeLaserScope -> Point2 -- ^ End point -> Float -- ^ Fraction of red/green -> Particle -makeLaserScope p ep relFrac = Particle +makeLaserScope p ep relFrac = PtTargetLaser {_ptDraw = const $ setLayer BloomLayer $ setDepth 20 $ pictures [lineAlphaThick 0.5 0.5 ,lineAlphaThick 0.2 1.5 ,lineAlphaThick 0.1 2 ] ,_ptUpdate = \w pt -> (w, Just $ pt & ptUpdate .~ \w' _ -> (w',Nothing)) + , _ptPoints = [p,ep] + , _ptColor = col } where lineAlphaThick a w = color (withAlpha a $ mixColors relFrac (1-relFrac) red green) $ thickLine w [p,ep] + col = mixColors relFrac (1-relFrac) red green diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index f839b6e37..4d2097986 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -198,12 +198,14 @@ targetLaserUpdate _ cr w t (mp, ps) = reflectLaserAlong 0.2 sp ep w sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr) ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp) - addLaserPic = instantParticles .:~ Particle + addLaserPic = instantParticles .:~ PtTargetLaser { _ptDraw = const $ setLayer BloomNoZWrite $ pictures [ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps) , setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp:ps) ] , _ptUpdate = ptSimpleTime 1 + , _ptPoints = (sp:ps) + , _ptColor = col } --wpammo = _itConsumption it -- reloadFrac diff --git a/src/Dodge/Item/Weapon/UseEffect.hs b/src/Dodge/Item/Weapon/UseEffect.hs index 3561aaefe..fcd9e75a2 100644 --- a/src/Dodge/Item/Weapon/UseEffect.hs +++ b/src/Dodge/Item/Weapon/UseEffect.hs @@ -36,6 +36,7 @@ aRadarPulse blipsF bf col cr = instantParticles .:~ RadarCircleParticle , _ptTimer = 100 , _ptRad = 0 , _ptPos = _crPos cr + , _ptColor = col } drawPulse :: Color -> Particle -> Picture drawPulse col pt = setLayer DebugLayer $ pictures sweepPics diff --git a/src/Dodge/Particle/Draw.hs b/src/Dodge/Particle/Draw.hs new file mode 100644 index 000000000..ed025a583 --- /dev/null +++ b/src/Dodge/Particle/Draw.hs @@ -0,0 +1,200 @@ +module Dodge.Particle.Draw where +import Dodge.Data +import Geometry +import Picture + +drawParticle :: Particle -> Picture +drawParticle pt = case pt of + PtFlame {} -> drawFlame pt + Shockwave {} -> drawShockwave pt + PtStaticBall {} -> drawStaticBall pt + PtIncBall {} -> drawFlameletZ pt + PtMuzFlare {} -> drawMuzFlare pt + PtCircFlare {} -> drawCircFlare pt + PtInvShockwave {} -> drawInverseShockwave pt + BulletPt {} -> drawBul pt + PtTeslaArc {} -> drawTeslaArc pt + PtTargetLaser {} -> drawTargetLaser pt + LaserParticle {} -> drawLaser pt + ShockLine {} -> drawSonicWave pt + RadarCircleParticle {} -> drawPulse pt + +drawFlame + :: Particle + -> Picture +drawFlame pt = pictures + [ glow + , aPic BloomNoZWrite prot2 25 (V2 (scaleChange + 1) 2 ) $ V4 2 (-1) (-1) 0.5 + , aPic BloomNoZWrite prot 22 (V2 (scaleChange + 0.5) 1 ) $ V4 1 0.5 0 2 + , aPic BloomLayer prot3 20 (V2 scaleChange 0.5) $ V4 1 1 1 1 + ] + where + rotd = _ptOriginalVel pt -- rotate direction + ep = _ptPos pt + aPic :: Layer -> (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture + aPic lay offset depth (V2 scalex scaley) col + = setLayer lay + . setDepth depth + . uncurryV translate (offset ep) + . rotate (pi * 0.5 + argV rotd) + . scale scalex scaley + . color col + $ circleSolid 5 + glow = setLayer BloomNoZWrite $ setDepth 0.3 $ uncurryV translate ep + $ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50 + time = _ptTimer pt + scaleChange + | time < 80 = 3 + | otherwise = 3 - (fromIntegral time - 80) * 0.2 + prot p' = p' +.+ rotateV (fromIntegral time) (V2 0 1) + prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (V2 0 1) + prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (V2 0 2) + +drawShockwave :: Particle -> Picture +drawShockwave pt = setDepth 20 + . setLayer BloomLayer + . uncurryV translate (_ptPos pt) + . color (_ptColor pt) + $ thickCircle rad thickness + where + r = _ptRad pt + thickness = tFraction**2 * r + rad = r - (3/4) * r * tFraction + tFraction = fromIntegral (_ptTimer pt) / fromIntegral (_ptMaxTime pt) + +drawStaticBall + :: Particle + -> Picture +drawStaticBall pt = setLayer BloomNoZWrite + . setDepth (_ptZ pt + 20) + . uncurryV translate (_ptPos pt) + $ circleSolidCol (_ptColor pt) (withAlpha 0.5 white) (_ptWidth pt+5) + +drawFlameletZ + :: Particle + -> Picture +drawFlameletZ pt = pictures + [ setLayer BloomLayer pic + , setLayer BloomNoZWrite piu + , setLayer BloomNoZWrite pi2 + ] + where + z = _ptZ pt + sp = _ptPos pt + vel = _ptVel pt + ep = sp +.+ vel + size = _ptWidth pt + siz2 = size + 0.2 + time = _ptTimer pt + piu = setDepth (z + 25) + . uncurryV translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + (V4 2 0 0 1) (V4 2 0 0 0) + ) + . rotate (negate (rot - 0.1 * fromIntegral time)) + . scale s1 s1 + $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) + pi2 = setDepth (z + 25) + . uncurryV translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + (V4 2 1 0 0.5) (V4 0 0 0 0) + ) + . rotate (negate (rot + 0.2 * fromIntegral time)) + . scale s2 s2 + $ polygon (rectNSWE siz2 (-siz2) (-siz2) siz2) + pic = setDepth (z + 20) + . uncurryV translate ep + . color (mixColors (fromIntegral (max 0 (time-2))) (10-fromIntegral time) + (V4 1 1 1 3) (V4 1 0 0 1) + ) + . rotate (negate ( 0.1 * fromIntegral time + rot)) + . scale (0.5* sc) (0.5 *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) + rot = _ptRot pt + +drawMuzFlare :: Particle -> Picture +drawMuzFlare pt = setLayer BloomNoZWrite . translate3 tranv $ theShape + where + tranv = _ptTran3 pt + col = _ptColor pt + poly = _ptPoly pt + theShape = color col $ polygon poly + +drawCircFlare :: Particle -> Picture +drawCircFlare pt = setLayer BloomNoZWrite . translate3 tranv + $ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50 + where + col = _ptColor pt + tranv = _ptTran3 pt + alphax = _ptAlpha pt + +drawInverseShockwave :: Particle -> Picture +drawInverseShockwave pt + = setLayer BloomLayer $ setDepth 20 $ uncurryV translate p + $ color cyan $ thickCircle rad thickness + where + p = _ptPos pt + r = _ptRad pt + t = _ptTimer pt + rad = r - 0.1 * r * fromIntegral (10 - t) + thickness = fromIntegral (10 - t) **2 * rad / 40 + +drawBul :: Particle -> Picture +drawBul pt = setLayer BloomNoZWrite + . setDepth 20 + . color (_ptColor pt) + -- $ thickLine (_ptWidth pt) (take 3 $ _ptTrail pt) + $ thickLine (_ptWidth pt) (take 2 $ _ptTrail pt) + +drawTeslaArc :: Particle -> Picture +drawTeslaArc pt = setLayer BloomNoZWrite $ pictures + [ setDepth 20.5 $ color (brightX 2 1 $ _ptColor pt) $ thickLine 3 ps + , setDepth 20 $ color (V4 0 0 0 0.5) $ thickLine 10 ps + ] + where + ps = _ptPoints pt + +drawTargetLaser :: Particle -> Picture +drawTargetLaser pt = setLayer BloomNoZWrite $ pictures + [ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp:ps) + , setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp:ps) + ] + where + col = _ptColor pt + (sp:ps) = _ptPoints pt + +drawLaser :: Particle -> Picture +--drawLaser pt = setLayer BloomNoZWrite $ pictures + --[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps +drawLaser pt = + setLayer BloomNoZWrite $ pictures +-- [ setDepth 19 . color (brightX 1 0.5 col) $ thickLine 20 ps + [ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps + ] + where + col = _ptColor pt + ps = _ptPoints pt + +drawSonicWave :: Particle -> Picture +drawSonicWave pt = foldMap (color (_ptColor pt) . setLayer BloomNoZWrite . setDepth 20 + . lineThick 20 + . map fst) + $ _ptPointDirs pt + +drawPulse :: Particle -> Picture +drawPulse pt = setLayer DebugLayer $ pictures sweepPics + where + col = _ptColor pt + p = _ptPos pt + r = _ptRad pt + sweepPics = [colHelper 0.1 $ uncurryV translate p $ thickCircle r 15 + ,colHelper 0.06 $ uncurryV translate p $ thickCircle (r-5) 5 + ,colHelper 0.03 $ uncurryV translate p $ thickCircle (r-10) 5 + ] + colHelper y = color (withAlpha (y * globalAlpha) col) + globalAlpha | x > 10 = 1 + | otherwise = fromIntegral x / 10 + x = _ptTimer pt diff --git a/src/Dodge/Particle/TeslaArc.hs b/src/Dodge/Particle/TeslaArc.hs index 48f3b0059..040f58a0c 100644 --- a/src/Dodge/Particle/TeslaArc.hs +++ b/src/Dodge/Particle/TeslaArc.hs @@ -20,7 +20,7 @@ import LensHelp --import Data.Maybe aTeslaArcAt :: Color -> [ArcStep] -> Particle -aTeslaArcAt col thearc = LinearParticle +aTeslaArcAt col thearc = PtTeslaArc { _ptPoints = map (^. asPos) thearc , _ptDraw = drawTeslaArc , _ptUpdate = moveTeslaArc thearc diff --git a/src/Dodge/RadarBlip.hs b/src/Dodge/RadarBlip.hs new file mode 100644 index 000000000..1d2f7fda0 --- /dev/null +++ b/src/Dodge/RadarBlip.hs @@ -0,0 +1,23 @@ +module Dodge.RadarBlip where +import Dodge.Data.RadarBlip +import Geometry.Data +import LensHelp +import Picture + +updateRadarBlip :: RadarBlip -> Maybe RadarBlip +updateRadarBlip rb + | _rbTime rb <= 0 = Nothing + | otherwise = Just $ rb & rbTime -~ 1 + +drawBlip :: RadarBlip -> Picture +drawBlip pt = setDepth (-0.5) + . setLayer DebugLayer + . uncurryV translate p + . color (withAlpha (fromIntegral t / fromIntegral maxt) col) + $ circleSolid r + where + p = _rbPos pt + t = _rbTime pt + r = _rbRad pt + col = _rbColor pt + maxt = _rbMaxTime pt diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index fea90e0c2..24d0aa1a9 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -25,9 +25,16 @@ import LensHelp import System.Random muzFlareAt :: Color -> Point3 -> Float -> World -> World -muzFlareAt col tranv dir w = w & instantParticles .:~ Particle +muzFlareAt col tranv dir w = w & instantParticles .:~ PtMuzFlare { _ptDraw = const $ setLayer BloomNoZWrite . translate3 tranv $ theShape , _ptUpdate = ptSimpleTime 2 + , _ptPoly = + [ V2 0 0 + , V2 a (-b) + , V2 c d + ] + , _ptColor = col + , _ptTran3 = tranv } where theShape = rotate dir . color col $ polygon @@ -38,10 +45,13 @@ muzFlareAt col tranv dir w = w & instantParticles .:~ Particle (a:b:c:d:_) = randomRs (2,20) (_randGen w) flareCircleAt :: Color -> Float -> Point3 -> World -> World -flareCircleAt col alphax tranv = instantParticles .:~ Particle +flareCircleAt col alphax tranv = instantParticles .:~ PtCircFlare { _ptDraw = const . setLayer BloomNoZWrite . translate3 tranv $ circleSolidCol (withAlpha 0 0) (withAlpha alphax col) 50 , _ptUpdate = ptSimpleTime 1 + , _ptColor = col + , _ptAlpha = alphax + , _ptTran3 = tranv } explosionFlashAt :: Point2 -> World -> World diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index dbbac1463..5a90ecb0f 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -129,7 +129,7 @@ concBall p = return Shockwave aStaticBall :: Point2 -> State g Particle -aStaticBall p = return PtZ +aStaticBall p = return PtStaticBall { _ptDraw = drawStaticBall , _ptUpdate = moveStaticBall , _ptVel = 0 @@ -153,7 +153,7 @@ makeFlamelet -> World makeFlamelet (V2 x y) z vel maycid size time w = w & randGen .~ g - & instantParticles .:~ PtZ + & instantParticles .:~ PtIncBall { _ptDraw = drawFlameletZ rot , _ptUpdate = moveFlamelet , _ptVel = vel @@ -164,6 +164,7 @@ makeFlamelet (V2 x y) z vel maycid size time w = w , _ptTimer = time , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 , _ptZ = z + , _ptRot = rot } where (rot ,g) = randomR (0,3) $ _randGen w @@ -255,7 +256,7 @@ cloudPoisonDamage c w = w & dodamagesto (S.filter f $ crsNearPoint clpos w) incBall :: RandomGen g => Point2 -> State g Particle incBall p = do rot <- state $ randomR (0,3) - return PtZ + return PtIncBall { _ptDraw = drawFlameletZ rot , _ptUpdate = moveFlamelet , _ptVel = 0 @@ -266,6 +267,7 @@ incBall p = do , _ptTimer = 20 , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 , _ptZ = 20 + , _ptRot = rot } drawFlameletZ :: Float -- ^ Rotation