Files
loop/src/Dodge/LightSource.hs
T

111 lines
2.8 KiB
Haskell

module Dodge.LightSource (
tlsTimeRadFunPos,
tlsTimeRadColPos,
lsRadCol,
lsColPosRad,
lsColPos,
lsPosCol,
lsPosRad,
lsColPosID,
makeTlsTimeRadColPos,
destroyLS,
) where
import Dodge.Data.World
import Dodge.Default.LightSource
import Dodge.Material.Sound
import Dodge.WorldEvent.Sound
import Geometry.Data
import Geometry.Vector
import Geometry.Vector3D
import LensHelp
lsPosRad :: Point3 -> Float -> LightSource
lsPosRad = lsColPosRad 0.75
tlsTimeRadFunPos :: Int -> Float -> TLSIntensity -> Point3 -> TempLightSource
tlsTimeRadFunPos t rmax intensityF p =
TLS
{ _tlsParam =
LSParam
{ _lsPos = p
, _lsRad = rmax
, _lsCol = 0 -- intensityF t
}
, _tlsUpdate = IntensityTLS intensityF
, _tlsTime = t
}
-- where
-- upF tls
-- | _tlsTime tls <= 0 = Nothing
-- | otherwise = Just $ tls
-- & tlsTime -~ 1
-- & tlsParam . lsCol .~ f (intensityF (_tlsTime tls) )
-- f x' = V3 x' x' x'
lsColPosID :: Point3 -> Point3 -> Int -> LightSource
lsColPosID col p i = lsColPos col p & lsID .~ i
lsColPos :: Point3 -> Point3 -> LightSource
lsColPos col pos = lsColPosRad col pos 450
lsPosCol :: Point3 -> Point3 -> LightSource
lsPosCol pos col = lsColPos col pos
lsColPosRad :: Point3 -> Point3 -> Float -> LightSource
lsColPosRad col p r =
defaultLS
& lsParam . lsPos .~ p
& lsParam . lsRad .~ r
& lsParam . lsCol .~ col
lsRadCol :: Float -> Point3 -> LightSource
lsRadCol r col =
defaultLS & lsParam . lsRad .~ r
& lsParam . lsCol .~ col
tlsTimeRadColPos ::
Int ->
-- | maximal radius
Float ->
Point3 ->
Point3 ->
TempLightSource
tlsTimeRadColPos t rmax col (V3 x y z) =
TLS
{ _tlsParam =
LSParam
{ _lsPos = V3 x y z
, _lsRad = rmax
, _lsCol = col
}
, _tlsUpdate = TimerTLS
, _tlsTime = t
}
makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World
makeTlsTimeRadColPos i rad (V3 r g b) p = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p
destroyLS :: Int -> World -> World
destroyLS lsid w =
w
& cWorld . lWorld . lightSources . at lsid .~ Nothing
& destroyLSFlashAt p3
& originsIDsAt [MaterialSound Glass n | n <- [0, 1, 2]] (destroyMatS Glass) (xyV3 p3)
where
ls = w ^?! cWorld . lWorld . lightSources . ix lsid -- unsafe
p3 = _lsPos $ _lsParam ls
destroyLSFlashAt :: Point3 -> World -> World
destroyLSFlashAt (V3 x' y' z') =
cWorld . lWorld . tempLightSources
.:~ tlsTimeRadFunPos
20
150
(TLSFade 1 10)
(addZ z' p)
where
p = V2 x' y'