Files
loop/src/Dodge/WorldEvent/Flash.hs
T

82 lines
2.3 KiB
Haskell

{- | Flashes.
projected naming conventions: three base types of light:
glare : Draws color onto surfaces (not done)
flare : coloured light drawn in space, fixed shapes
light : removal of shadows (onto surfaces)
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
( sparkFlashAt
, explosionFlashAt
, laserGunFlashAt
, teslaGunFlashAt
, muzFlareAt
, flameFlicker
)
where
import Dodge.Data
import Dodge.LightSources.Lamp
import Dodge.WorldEvent.HelperParticle
import Dodge.Default
import Picture
import Geometry
import Control.Lens
import System.Random
{- Cyan flash. -}
teslaGunFlashAt :: Point3 -> World -> World
teslaGunFlashAt = flareCircleAt cyan 0.7
{- Yellow flash. -}
laserGunFlashAt :: Point3 -> World -> World
laserGunFlashAt = flareCircleAt yellow 0.2
muzFlareAt :: Color -> Point3 -> Float -> World -> World
muzFlareAt col tranv dir w = w & particles %~ (theFlare :)
where
theFlare = Particle
{ _ptDraw = const $ setLayer 1 . translate3 tranv $ theShape
, _ptUpdate = ptSimpleTime 2
}
theShape = rotate dir . color col $ polygon
[ V2 0 0
, V2 a (-b)
, V2 c d
]
(a:b:c:d:_) = randomRs (2,20) (_randGen w)
flareCircleAt :: Color -> Float -> Point3 -> World -> World
flareCircleAt col alphax tranv = particles %~ (theFlareCircle :)
where
theFlareCircle = Particle
{ _ptDraw = const . setLayer 1 . translate3 tranv
$ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
, _ptUpdate = ptSimpleTime 1
}
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = tempLightSources %~ (tLightTimedIntensity 20 150 intensityFunc p :)
where
intensityFunc x
| x < 10 = 1 / (10 - fromIntegral x)
| otherwise = 1
sparkFlashAt :: Point2 -> World -> World
sparkFlashAt _ = id
flameFlicker :: Particle -> World -> World
flameFlicker pt
| _btTimer' pt `mod` 5 == 0 = tempLightSources %~ (theLight :)
| otherwise = id
where
V2 x y = _btPos' pt
theLight = defaultTLS
{ _tlsPos = V3 x y 10
, _tlsRad = 70
, _tlsIntensity = V3 0.5 0 0
}