justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Improve wall glare

Browse Source
This commit is contained in:
jgk
2021-03-24 21:33:15 +01:00
parent 7fd49d9b41
commit baecb8e15a
4 changed files with 26 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
-9
View File
@@ -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
src/Dodge/Item/Weapon.hs
+1 -1
View File
@@ -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]
src/Dodge/WorldEvent/Flash.hs
+20 -22
View File
@@ -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
src/Geometry.hs
+5
View File
@@ -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 #-}