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

Hlinting

Browse Source
This commit is contained in:
jgk
2021-04-27 11:45:43 +02:00
parent f8351fb150
commit 64b5b9e2a5
34 changed files with 974 additions and 761 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/WorldEvent/Flash.hs
+53 -48
View File
@@ -1,3 +1,13 @@
{- | Flashes.
projected naming conventions: 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
-}
module Dodge.WorldEvent.Flash
where
import Dodge.Data
@@ -13,71 +23,67 @@ 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
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
where
ps = map (p +.+) $ nRaysRad nrays rad
{- White flash. -}
sparkFlashAt :: Point2 -> World -> World
sparkFlashAt p =
glareAt 2 10 5 (withAlpha 0.05 white) 20 30 p
sparkFlashAt =
glareAt 2 10 5 (withAlpha 0.05 white) 20 30
{- Red flash. -}
bloodFlashAt :: Point2 -> World -> World
bloodFlashAt p =
over particles' ((:) (flashFlareAt red 0.4 p))
. glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p
over particles (flashFlareAt red 0.4 p : )
. glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p
{- Cyan flash. -}
teslaGunFlashAt :: Point2 -> World -> World
teslaGunFlashAt p =
over particles' ((:) (flashFlareAt cyan 0.3 p))
. glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p
teslaGunFlashAt p =
over particles (flashFlareAt cyan 0.3 p : )
. glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p
{- Yellow flash. -}
laserGunFlashAt :: Point2 -> World -> World
laserGunFlashAt p =
over particles' ((:) (flashFlareAt yellow 0.2 p))
. glareAt 2 10 5 (withAlpha 0.05 yellow) 20 30 p
over particles (flashFlareAt yellow 0.2 p : )
. glareAt 2 10 5 (withAlpha 0.05 yellow) 20 30 p
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 col a b w
glareLine' t len wdth col a b w = w & particles %~ (maybeToList linePt ++)
where
linePt :: Maybe Particle
linePt = glareBetween t len wdth col a b w
glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle'
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
,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w')
}
glareBetween t 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
= case thingsHit a b w of
lowLightPic len wdth col (a,b) w = case thingsHit a b w of
((p, E3x2 wall):_)
-> setCol . lineOfThickness wdth $ [alongSegBy len p wa, alongSegBy len p wb]
where x = len *.* (normalizeV $ wa -.- wb)
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 col . setDepth (-0.5) . setLayer 2
where setCol = color col . setDepth (-0.5) . setLayer 2
flashFlareAt :: Color -> Float -> Point2 -> Particle'
flashFlareAt col alphax (x,y) =
Particle'
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
, _ptUpdate' = ptTimer' 1
}
flashFlareAt :: Color -> Float -> Point2 -> Particle
flashFlareAt col alphax (x,y) = Particle
{ _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y
$ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
, _ptUpdate' = ptTimer' 1
}
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
@@ -94,19 +100,18 @@ lowLightDirected col a b angles w
muzzleFlashAt :: Point2 -> World -> World
muzzleFlashAt p = over particles' ((:) (muzzleFlashPt p))
muzzleFlashAt p = over particles (muzzleFlashPt p : )
. glareAt 2 10 5 (withAlpha 0.5 white) 20 30 p
muzzleFlashPt :: Point2 -> Particle'
muzzleFlashPt (x,y) =
Particle'
{ _ptDraw = const $ setDepth 0
. setLayer 2
. translate x y
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
, _ptUpdate' = ptTimer' 1
}
muzzleFlashPt :: Point2 -> Particle
muzzleFlashPt (x,y) = Particle
{ _ptDraw = const $ setDepth 0
. setLayer 2
. translate x y
$ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
, _ptUpdate' = ptTimer' 1
}
laserScopeTargetGlow :: Color -> Point2 -> World -> World
laserScopeTargetGlow col p = glareAt 2 3 1 (withAlpha 0.1 col) 15 5 p
laserScopeTargetGlow col = glareAt 2 3 1 (withAlpha 0.1 col) 15 5