From baecb8e15a424d53a7bf9c577d042821c2656571 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 24 Mar 2021 21:33:15 +0100 Subject: [PATCH] Improve wall glare --- src/Dodge/Data.hs | 9 -------- src/Dodge/Item/Weapon.hs | 2 +- src/Dodge/WorldEvent/Flash.hs | 42 +++++++++++++++++------------------ src/Geometry.hs | 5 +++++ 4 files changed, 26 insertions(+), 32 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f9dff663f..5651b88e5 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -432,15 +432,6 @@ data Particle' { _ptDraw :: Particle' -> Picture , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') } - | GlareLine - { _ptDraw :: Particle' -> Picture - , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') - , _glareTimer :: Int - , _glareLength :: Float - , _glareWidth :: Float - , _glareColor :: Color - , _glareLine :: (Point2,Point2) - } | Bul' { _ptDraw :: Particle' -> Picture , _ptUpdate' :: World -> Particle' -> (World, Maybe Particle') , _btVel' :: Point2 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index c4b004c94..f28347858 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -1067,7 +1067,7 @@ moveRemoteBomb itid time pID w updatePicture = set (projectiles . ix pID.ptPict) (onLayer PtLayer $ uncurry translate newPos $ remoteBombPic time) - . lowLightDirected red 0.1 newPos + . lowLightDirected (withAlpha 0.1 red) newPos (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time))) [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2] diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 59266c856..721b9d1ea 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -22,48 +22,46 @@ import Control.Lens -- glow : continuous, potentially long, fading, slow changes in alpha -- flicker : potentially long, moving, abrupt changes in alpha -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 +glareAt :: Int -> Float -> Float -> Color -> Int -> Float -> Point2 -> World -> World +glareAt t len wdth col nrays rad p w = foldr (glareLine' t len wdth col p) w ps where ps = map ((+.+) p) $ nRaysRad nrays rad sparkFlashAt :: Point2 -> World -> World sparkFlashAt p = --- over particles' ((:) (flashFlareAt white 0.2 p)) - glareAt 2 10 5 white 0.05 20 30 p + glareAt 2 10 5 (withAlpha 0.05 white) 20 30 p bloodFlashAt :: Point2 -> World -> World bloodFlashAt p = over particles' ((:) (flashFlareAt red 0.4 p)) - . glareAt 2 10 5 red 0.05 20 30 p + . glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p teslaGunFlashAt :: Point2 -> World -> World teslaGunFlashAt p = over particles' ((:) (flashFlareAt cyan 0.3 p)) - . glareAt 2 10 5 cyan 0.1 20 30 p + . glareAt 2 10 5 (withAlpha 0.1 cyan) 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 2 10 5 (withAlpha 0.05 yellow) 20 30 p - -glareLine' :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World -glareLine' t len wdth col alphay a b w = w & particles' %~ (maybeToList linePt ++) +glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World +glareLine' t len wdth col a b w = w & particles' %~ (maybeToList linePt ++) where linePt :: Maybe Particle' - linePt = glareBetween t len wdth (withAlpha alphay col) a b w + linePt = glareBetween t len wdth col a b w glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle' glareBetween 0 _ _ _ _ _ _ = Nothing glareBetween t len wdth col a b w - = Just $ Particle' {_ptDraw = const $ lowLightPic len wdth col a b w + = Just $ Particle' {_ptDraw = const $ lowLightPic len wdth col (a,b) w ,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w') } -lowLightPic :: Float -> Float -> Color -> Point2 -> Point2 -> World -> Picture -lowLightPic len wdth col a b w +lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture +lowLightPic len wdth col (a,b) w = case thingsHitLongLine a b w of ((p, E3x2 wall):_) - -> setCol . lineOfThickness wdth $ [p +.+ x, p -.- x] + -> setCol . lineOfThickness wdth $ [alongLineBy len p wa, alongLineBy len p wb] where x = len *.* (normalizeV $ wa -.- wb) (wa:wb:_) = _wlLine wall ((p, E3x1 cr):_) @@ -83,21 +81,21 @@ flashFlareAt col alphax (x,y) = explosionFlashAt :: Point2 -> World -> World explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p) - . glareAt 20 10 5 white 0.3 75 150 p + . glareAt 20 10 5 (withAlpha 0.3 white) 75 150 p where intensityFunc x | x < 10 = 1 / (10 - fromIntegral x) | otherwise = 1 -flameGlareAt = glareAt 1 10 5 orange 0.05 8 40 +flameGlareAt = glareAt 1 10 5 (withAlpha 0.05 orange) 8 40 -lowLightDirected :: Color -> Float -> Point2 -> Point2 -> [Float] -> World -> World -lowLightDirected col alpha a b angles w - = foldr (\angle w' -> glareLine' 2 10 5 col alpha a (a +.+ rotateV angle b) w') w angles +lowLightDirected :: Color -> Point2 -> Point2 -> [Float] -> World -> World +lowLightDirected col a b angles w + = foldr (\angle w' -> glareLine' 2 10 5 col a (a +.+ rotateV angle b) w') w angles muzzleFlashAt :: Point2 -> World -> World muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p)) - . glareAt 2 10 5 white 0.5 20 30 p + . glareAt 2 10 5 (withAlpha 0.5 white) 20 30 p muzzleFlashPt :: Point2 -> Particle' muzzleFlashPt (x,y) = @@ -110,5 +108,5 @@ muzzleFlashPt (x,y) = } laserScopeTargetGlow :: Color -> Point2 -> World -> World -laserScopeTargetGlow col p = glareAt 2 3 1 col 0.1 15 5 p +laserScopeTargetGlow col p = glareAt 2 3 1 (withAlpha 0.1 col) 15 5 p diff --git a/src/Geometry.hs b/src/Geometry.hs index 6bf68f01d..a147849d2 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -18,6 +18,11 @@ import Data.Maybe import Control.Applicative +alongLineBy :: Float -> Point2 -> Point2 -> Point2 +alongLineBy x a b = a +.+ y *.* normalizeV (b -.- a) + where + y = min x $ dist a b + closestPointOnLine :: Point2 -> Point2 -> Point2 -> Point2 {-# INLINE closestPointOnLine #-}