From 3e2eaeece261239ef1b0431f587cdde8553504bd Mon Sep 17 00:00:00 2001 From: jgk Date: Tue, 23 Mar 2021 17:39:34 +0100 Subject: [PATCH] Refactor flash lighting, determine (projected) namespace --- src/Dodge/Item/Weapon.hs | 4 +- src/Dodge/Item/Weapon/Bullet.hs | 2 +- src/Dodge/WorldEvent.hs | 10 +- src/Dodge/WorldEvent/Flash.hs | 159 +++++++++----------------------- 4 files changed, 53 insertions(+), 122 deletions(-) diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 564f255cb..5f0568d9e 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -663,7 +663,7 @@ aTeslaArc cid w = aTeslaArc' cid aTeslaArc' :: Int -> World -> World aTeslaArc' cid w = - flareAt' cyan 0.03 0.1 (pos +.+ 5 *.* unitVectorAtAngle dir) + teslaGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) $ over projectiles (IM.insert i (makeTeslaArcAt i pos dir)) $ set randGen g w where cr = (_creatures w IM.! cid) @@ -676,7 +676,7 @@ aTeslaArc' cid w = aLaser :: Int -> World -> World aLaser cid w = over particles' ( (:) (makeLaserAt phaseV pos dir (Just cid))) $ soundFrom LasSound 24 1 0 - $ flareAt' yellow 0.02 0.05 (pos +.+ 5 *.* unitVectorAtAngle dir) + $ laserGunFlashAt (pos +.+ 5 *.* unitVectorAtAngle dir) w where cr = (_creatures w IM.! cid) i = newProjectileKey w diff --git a/src/Dodge/Item/Weapon/Bullet.hs b/src/Dodge/Item/Weapon/Bullet.hs index c305a4977..38367dfeb 100644 --- a/src/Dodge/Item/Weapon/Bullet.hs +++ b/src/Dodge/Item/Weapon/Bullet.hs @@ -28,7 +28,7 @@ bulHitCr' bt p cr w = addDamageArmoured = over (creatures . ix cid . crState . crDamage) (\dams -> mvDams ++ dams) hitSound = soundMultiFrom [CrHitSound 0] 15 10 0 - flashEff = over worldEvents ((.) $ flareAt' red 0.02 0.05 p) + flashEff = over worldEvents ((.) $ bloodFlashAt p) bulVel = _btVel' bt ck cid = (+.+) (crKnockBack cid *.* bulVel) crKnockBack cid = (/) 1 $ (+) 2 $ _crMass $ _creatures w IM.! cid diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 9111fa89f..bba30af45 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -170,7 +170,8 @@ moveInverseShockWave t p r push pushexp w pt createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World createSpark time colid pos dir maycid w = over worldEvents ((.) $ ( over particles' ((:) spark) - . flareAt' white 0.02 0.05 pos') +-- . flareAt' white 0.02 0.05 pos') + . sparkFlashAt pos') ) w where spark = Bul' { _ptPict' = blank , _ptUpdate' = mvGenBullet' @@ -192,8 +193,7 @@ createSpark time colid pos dir maycid w = over worldEvents createBarrelSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World createBarrelSpark time colid pos dir maycid w = over worldEvents ((.) $ ( over particles' ((:) spark) - . flareAt' white 0.005 0.03 pos') - -- . lowLightAt' pos) + . sparkFlashAt pos') ) w where spark = Bul' { _ptPict' = blank , _ptUpdate' = mvGenBullet' @@ -216,8 +216,8 @@ noEff _ _ _ = id makeFlameletTimed :: Point2 -> Point2 -> Int -> Maybe Int -> Float -> Int -> World -> World makeFlameletTimed pos vel levelInt maycid size time w - = set randGen g $ over particles' ((:) theFlamelet) - $ flareAt' white 0.01 0.1 pos w + = set randGen g $ over particles' ((:) theFlamelet) w +-- $ flareAt' white 0.01 0.1 pos w where theFlamelet = Pt' { _ptPict' = blank , _ptUpdate' = moveFlamelet levelInt rot diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index bcf5ad259..3f429086d 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -13,20 +13,43 @@ import Geometry import Data.Maybe (maybeToList) import Control.Lens +-- projected naming: three base types of light: +-- glare : "low lighting", draws lines around creatures and walls +-- flare : coloured light drawn on top of picture in fixed shapes +-- light : removal of shadows +-- duration (subject to modification): +-- flash : short, abrupt changes in alpha +-- glow : continuous, potentially long, fading, slow changes in alpha +-- flicker : potentially long, moving, abrupt changes in alpha -flareAt' :: Color -> Float -> Float -> Point2 -> World -> World -flareAt' col alphax alphay p - = -- over particles' ((:) (flashColAt col alphax p)) - -- . - lowLightColAt col alphay p +sparkFlashAt :: Point2 -> World -> World +sparkFlashAt p = + over particles' ((:) (flashFlareAt white 0.2 p)) + . glareAt 2 10 5 white 0.05 20 30 p -lowLightColAt :: Color -> Float -> Point2 -> World -> World -lowLightColAt col alphay p w = foldr (lowLightWidthHit 10 5 col alphay p) w ps - where ps = map ((+.+) p) $ nRaysRad 20 30 +bloodFlashAt :: Point2 -> World -> World +bloodFlashAt p = + over particles' ((:) (flashFlareAt red 0.2 p)) + . glareAt 2 10 5 red 0.05 20 30 p -lowLightWidthForHit :: Float -> Float -> Color -> Float -> Int -> Point2 -> Point2 -> World -> World -lowLightWidthForHit len wdth col alphay t a b w = w & particles' %~ (maybeToList glareLine ++) - where glareLine = glareBetween t len wdth col alphay a b w +teslaGunFlashAt :: Point2 -> World -> World +teslaGunFlashAt p = + over particles' ((:) (flashFlareAt cyan 0.3 p)) + . glareAt 2 10 5 cyan 0.1 20 30 p + +laserGunFlashAt :: Point2 -> World -> World +laserGunFlashAt p = + over particles' ((:) (flashFlareAt yellow 0.2 p)) + . glareAt 2 10 5 yellow 0.05 20 30 p + +glareAt :: Int -> Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World +glareAt t len wdth col alphay nrays rad p w = foldr (glareLine t len wdth col alphay p) w ps + where ps = map ((+.+) p) $ nRaysRad nrays rad + +glareLine :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World +glareLine t len wdth col alphay a b w = w & particles' %~ (maybeToList linePt ++) + where linePt :: Maybe Particle' + linePt = glareBetween t len wdth col alphay a b w glareBetween :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Maybe Particle' glareBetween 0 _ _ _ _ _ _ _ = Nothing @@ -49,92 +72,23 @@ lowLightPic len wdth col alphay a b w _ -> blank where setCol = color (withAlpha alphay col) . setDepth 0 . setLayer 1 -lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World -lowLightWidthHit len wdth col alphay a b w - = case thingsHitLongLine a b w of - ((p, E3x2 wall):_) - -> over particles' ((:) (wallGlareWidth len wdth col alphay p wall)) w - ((p, E3x1 cr):_) - -> over particles' ((:) (crGlareWidth wdth col alphay p cr)) w - _ -> w - -flashColAt :: Color -> Float -> Point2 -> Particle' -flashColAt col alphax (x,y) = +flashFlareAt :: Color -> Float -> Point2 -> Particle' +flashFlareAt col alphax (x,y) = Particle' - { _ptPict' = pictures $ - map (\i -> onLayerL [levLayer PtLayer] - $ color (withAlpha alphax col) $ translate x y $ circleSolid i - ) - [20,25,30,35,40,45,50] + { _ptPict' = setLayer 2 . setDepth (-0.9) . translate x y + $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30 , _ptUpdate' = ptTimer' 1 } -wallGlareFor :: Int -> Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle' -wallGlareFor t len wdth col alphay p wl = - Particle' - { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l - , _ptUpdate' = ptTimer' t - } - where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x] - x = len *.* ( normalizeV $ a -.- b) - (a:b:_) = _wlLine wl - -wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle' -wallGlareWidth len wdth col alphay p wl = - Particle' - { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l - , _ptUpdate' = ptTimer' 1 - } - where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x] - x = len *.* ( normalizeV $ a -.- b) - (a:b:_) = _wlLine wl - -crGlareFor :: Int -> Float -> Color -> Float -> Point2 -> Creature -> Particle' -crGlareFor t wdth col alphay p cr = - Particle' - { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp - , _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w - ,_ptUpdate' = ptTimer' (t - 1) - } - ) - } - where l x = uncurry translate x - $ rotate (-0.25*pi + argV (p -.- x)) - $ color (withAlpha alphay col) - $ thickArc 0 (pi/2) (_crRad cr) wdth - cp = _crPos cr - cid = _crID cr - upp cid' w' = case w' ^? creatures . ix cid . crPos of - Just y -> l y - _ -> blank - -crGlareWidth :: Float -> Color -> Float -> Point2 -> Creature -> Particle' -crGlareWidth wdth col alphay p cr = - Particle' - { _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp - , _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w - ,_ptUpdate' = ptTimer' 0 - } - ) - } - where l x = uncurry translate x - $ rotate (-0.25*pi + argV (p -.- x)) - $ color (withAlpha alphay col) - $ thickArc 0 (pi/2) (_crRad cr) wdth - cp = _crPos cr - cid = _crID cr - upp cid' w' = case w' ^? creatures . ix cid . crPos of - Just y -> l y - _ -> blank flareWidth :: Float -> Float -> Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World flareWidth len wdth rad rays col ax ay p = over particles' ((:) (flashRadAt rad col ax p)) - . lowLightWidthAt len wdth col ay rays rad p + . glareAt 2 len wdth col ay rays rad p flareRad :: Float -> Int -> Color -> Float -> Float -> Point2 -> World -> World flareRad rad rays col ax ay p = over particles' ((:) (flashRadAt rad col ax p)) - . lowLightWidthAt 10 5 col ay rays rad p + . glareAt 2 10 5 col ay rays rad p flashRadAt :: Float -> Color -> Float -> Point2 -> Particle' flashRadAt rad col alphax (x,y) = @@ -147,33 +101,23 @@ flashRadAt rad col alphax (x,y) = , _ptUpdate' = ptTimer' 1 } -lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> World -> World -lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps - where ps = map ((+.+) p) $ nRaysRad rays rad - -lowLightAtFor :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> Int -> World -> World -lowLightAtFor len wdth col alphay rays rad p t w - = foldr (lowLightWidthForHit len wdth col alphay t p) w ps - where ps = map ((+.+) p) $ nRaysRad rays rad - - explosionFlashAt :: Point2 -> World -> World explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p) - . lowLightAtFor 10 5 white 0.3 75 150 p 20 + . glareAt 20 10 5 white 0.3 75 150 p where intensityFunc x | x < 10 = 1 / (10 - fromIntegral x) | otherwise = 1 -flameGlareAt = lowLightWidthAt 10 5 orange 0.05 8 50 +flameGlareAt = glareAt 2 10 5 orange 0.05 8 50 lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World lowLightDirected col alpha a b angles w - = foldr (\angle w' -> lowLightWidthHit 10 5 col alpha a (a +.+ rotateV angle b) w') w angles + = foldr (\angle w' -> glareLine 2 10 5 col alpha a (a +.+ rotateV angle b) w') w angles muzFlareAt :: Point2 -> World -> World muzFlareAt p = over particles' ((:) (muzzleFlarePt p)) - . lowLightWidthAt 10 5 white 0.5 20 30 p + . glareAt 2 10 5 white 0.5 20 30 p muzzleFlarePt :: Point2 -> Particle' muzzleFlarePt (x,y) = @@ -187,18 +131,5 @@ muzzleFlarePt (x,y) = lowLightAt :: Point2 -> World -> World -lowLightAt p w = lowLightWidthAt 10 5 white 0.5 20 30 p w +lowLightAt p w = glareAt 2 10 5 white 0.5 20 30 p w -lowLightAt' :: Point2 -> World -> World -lowLightAt' p w = foldr (lowLightHit' p) w ps - where ps = map ((+.+) p) $ nRaysRad 20 30 - -lowLightHit' :: Point2 -> Point2 -> World -> World -lowLightHit' a b w - = case thingsHitLongLine a b w of - ((p, E3x2 wall):_) - -> over particles' ((:) (wallGlare' p wall)) w - _ -> w - -wallGlare' :: Point2 -> Wall -> Particle' -wallGlare' p wl = wallGlareWidth 5 5 white 0.1 p wl