Refactor low light display

This commit is contained in:
jgk
2021-03-23 16:05:37 +01:00
parent 451ef98b9f
commit e0d49cdf57
+11 -7
View File
@@ -10,6 +10,8 @@ import Dodge.WorldEvent.HelperParticle
import Picture
import Geometry
import Data.Maybe (maybeToList)
import Control.Lens
flareAt' :: Color -> Float -> Float -> Point2 -> World -> World
@@ -23,13 +25,15 @@ lowLightColAt col alphay p w = foldr (lowLightWidthHit 10 5 col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad 20 30
lowLightWidthForHit :: Float -> Float -> Color -> Float -> Int -> Point2 -> Point2 -> World -> World
lowLightWidthForHit len wdth col alphay t a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlareFor t len wdth col alphay p wall)) w
((p, E3x1 cr):_)
-> over particles' ((:) (crGlareFor t wdth col alphay p cr)) w
_ -> w
lowLightWidthForHit len wdth col alphay t a b w = w & particles' %~ (maybeToList glareLine ++)
where glareLine = glareBetween t len wdth col alphay a b w
glareBetween :: Int -> Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Maybe Particle'
glareBetween 0 _ _ _ _ _ _ _ = Nothing
glareBetween t len wdth col alphay a b w
= Just $ Particle' {_ptPict' = lowLightPic len wdth col alphay a b w
,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col alphay a b w')
}
lowLightPic :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Picture
lowLightPic len wdth col alphay a b w