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

General cleanup, remove Drawing type synonym

Browse Source
This commit is contained in:
justin
2021-03-23 15:48:14 +01:00
parent b13467053a
commit 451ef98b9f
8 changed files with 100 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent/Flash.hs
+58 -1
View File
@@ -22,6 +22,29 @@ 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
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
lowLightPic :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Picture
lowLightPic len wdth col alphay a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> setCol . lineOfThickness wdth $ [p +.+ x, p -.- x]
where x = len *.* (normalizeV $ wa -.- wb)
(wa:wb:_) = _wlLine wall
((p, E3x1 cr):_)
-> setCol . uncurry translate cp . rotate (-0.25 * pi + argV (p -.- cp))
$ thickArc 0 (pi/2) (_crRad cr) wdth
where cp = _crPos cr
_ -> 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
@@ -41,6 +64,15 @@ flashColAt col alphax (x,y) =
[20,25,30,35,40,45,50]
, _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 =
@@ -52,6 +84,25 @@ wallGlareWidth len wdth col alphay p wl =
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'
@@ -96,9 +147,15 @@ lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 ->
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)
. lowLightWidthAt 10 5 white 0.3 75 150 p
. lowLightAtFor 10 5 white 0.3 75 150 p 20
where intensityFunc x
| x < 10 = 1 / (10 - fromIntegral x)
| otherwise = 1