diff --git a/src/Dodge/Data/LightSource.hs b/src/Dodge/Data/LightSource.hs index 2fba94400..c20e1b331 100644 --- a/src/Dodge/Data/LightSource.hs +++ b/src/Dodge/Data/LightSource.hs @@ -2,24 +2,32 @@ {-# LANGUAGE StrictData #-} module Dodge.Data.LightSource where import Geometry -import Picture.Data import Control.Lens +data LightSourceDraw = DefaultLightSourceDraw + +data TLSIntensity = ConstantIntensity + | TLSFade Point3 Int + +data TLSUpdate = DestroyTLS + | TimerTLS + | IntensityTLS TLSIntensity + data LSParam = LSParam { _lsPos :: !Point3 , _lsRad :: !Float , _lsCol :: !Point3 } data LightSource = LS - { _lsID :: !Int + { _lsID :: Int , _lsParam :: LSParam - , _lsDir :: !Float - , _lsPict :: LightSource -> Picture + , _lsDir :: Float + , _lsPict :: LightSourceDraw --LightSource -> Picture } data TempLightSource = TLS { _tlsParam :: LSParam - , _tlsUpdate :: TempLightSource -> Maybe TempLightSource - , _tlsTime :: !Int + , _tlsUpdate :: TLSUpdate --TempLightSource -> Maybe TempLightSource + , _tlsTime :: Int } makeLenses ''LSParam makeLenses ''LightSource diff --git a/src/Dodge/Default/LightSource.hs b/src/Dodge/Default/LightSource.hs index 4723bc520..e15c93e5a 100644 --- a/src/Dodge/Default/LightSource.hs +++ b/src/Dodge/Default/LightSource.hs @@ -1,8 +1,6 @@ module Dodge.Default.LightSource where import Dodge.Data -import Picture import Geometry -import LensHelp defaultLS :: LightSource defaultLS = LS @@ -13,13 +11,8 @@ defaultLS = LS , _lsCol = 0.6 } , _lsDir = 0 - , _lsPict = defLSPic + , _lsPict = DefaultLightSourceDraw --defLSPic } -defLSPic :: LightSource -> Picture -defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4 - where - col = V4 r g b 2 - V3 r g b = _lsCol $ _lsParam ls defaultTLS :: TempLightSource defaultTLS = TLS { _tlsParam = LSParam @@ -27,10 +20,6 @@ defaultTLS = TLS , _lsRad = 0 , _lsCol = 0.5 } - , _tlsUpdate = f + , _tlsUpdate = TimerTLS , _tlsTime = 1 } - where - f t - | _tlsTime t <= 0 = Nothing - | otherwise = Just $ t & tlsTime -~ 1 diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index 6b91ea9e2..b6c229ab9 100644 --- a/src/Dodge/LightSource.hs +++ b/src/Dodge/LightSource.hs @@ -24,23 +24,23 @@ import Dodge.Material.Sound lsPosRad :: Point3 -> Float -> LightSource lsPosRad = lsColPosRad 0.75 -tlsTimeRadFunPos :: Int -> Float -> (Int -> Float) -> Point3 -> TempLightSource +tlsTimeRadFunPos :: Int -> Float -> TLSIntensity -> Point3 -> TempLightSource tlsTimeRadFunPos t rmax intensityF p = TLS { _tlsParam = LSParam { _lsPos = p , _lsRad = rmax - , _lsCol = f $ intensityF t + , _lsCol = 0 -- intensityF t } - , _tlsUpdate = upF + , _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' +-- upF tls +-- | _tlsTime tls <= 0 = Nothing +-- | otherwise = Just $ tls +-- & tlsTime -~ 1 +-- & tlsParam . lsCol .~ f (intensityF (_tlsTime tls) ) +-- f x' = V3 x' x' x' lsPosColRad :: Point3 -> Point3 -> Float -> LightSource lsPosColRad p col = lsColPosRad col p @@ -79,14 +79,9 @@ tlsTimeRadColPos t rmax col (V3 x y z) = TLS , _lsRad = rmax , _lsCol = col } - , _tlsUpdate = upF + , _tlsUpdate = TimerTLS , _tlsTime = t } - where - upF tls - | _tlsTime tls <= 0 = Nothing - | otherwise = Just $ tls - & tlsTime -~ 1 makeTlsTimeRadColPos :: Int -> Float -> Point3 -> Point3 -> World -> World makeTlsTimeRadColPos i rad (V3 r g b) p = tempLightSources .:~ tlsTimeRadColPos i rad (V3 r g b) p @@ -101,9 +96,8 @@ destroyLS lsid w = w p3 = _lsPos $ _lsParam ls destroyLSFlashAt :: Point3 -> World -> World -destroyLSFlashAt (V3 x' y' z') = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc (addZ z' p) +destroyLSFlashAt (V3 x' y' z') = tempLightSources .:~ tlsTimeRadFunPos 20 150 + (TLSFade 1 10) + (addZ z' p) where p = V2 x' y' - intensityFunc x - | x < 10 = 1 / (10 - fromIntegral x) - | otherwise = 1 diff --git a/src/Dodge/LightSource/Draw.hs b/src/Dodge/LightSource/Draw.hs new file mode 100644 index 000000000..79935369e --- /dev/null +++ b/src/Dodge/LightSource/Draw.hs @@ -0,0 +1,13 @@ +module Dodge.LightSource.Draw where +import Dodge.Data.LightSource +import Picture +import Geometry.Data + +drawLightSource :: LightSourceDraw -> LightSource -> Picture +drawLightSource lsd = case lsd of + DefaultLightSourceDraw -> defLSPic +defLSPic :: LightSource -> Picture +defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4 + where + col = V4 r g b 2 + V3 r g b = _lsCol $ _lsParam ls diff --git a/src/Dodge/LightSource/Update.hs b/src/Dodge/LightSource/Update.hs new file mode 100644 index 000000000..21b0c5e6f --- /dev/null +++ b/src/Dodge/LightSource/Update.hs @@ -0,0 +1,24 @@ +module Dodge.LightSource.Update where +import Dodge.Data.LightSource +import Geometry +import Control.Lens + +updateTempLightSource :: TLSUpdate -> TempLightSource -> Maybe TempLightSource +updateTempLightSource tlsu = case tlsu of + DestroyTLS -> const Nothing + TimerTLS -> timerTLS + IntensityTLS ConstantIntensity -> updateTempLightSource TimerTLS + IntensityTLS (TLSFade startcol x) -> fadeTLS startcol x + +fadeTLS :: Point3 -> Int -> TempLightSource -> Maybe TempLightSource +fadeTLS startcol x tls + | t < 1 = Nothing + | t < x = Just $ tls & tlsParam . lsCol .~ (1 / fromIntegral (x - t)) *.*.* startcol + | otherwise = Just $ tls & tlsParam . lsCol .~ startcol -- this is wasteful, should be set once at begining + where + t = _tlsTime tls + +timerTLS :: TempLightSource -> Maybe TempLightSource +timerTLS t + | _tlsTime t <= 0 = Nothing + | otherwise = Just $ t & tlsTime -~ 1 diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 4e43c9238..22abc3904 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,6 +1,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where +import Dodge.LightSource.Draw import Dodge.Targeting.Draw import Dodge.Beam.Draw import Dodge.RadarSweep.Draw @@ -127,7 +128,7 @@ extraPics cfig w = pictures (_decorations w) <> concatMapPic drawFlare (_flares w) <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams w) <> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams w) - <> concatMapPic (dbArg _lsPict) (_lightSources w) + <> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources w) <> testPic cfig w <> concatMapPic clDraw (_clouds w ) <> concatMapPic ppDraw (_pressPlates w ) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 0d5b16928..81d8b1bc7 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -6,6 +6,7 @@ Description : Simulation update module Dodge.Update ( updateUniverse ) where import Dodge.Data import Dodge.Beam +import Dodge.LightSource.Update import Dodge.Projectile.Update import Dodge.Creature.Update import Dodge.RadarSweep @@ -209,7 +210,7 @@ updateDistortions = distortions %~ mapMaybe updateDistortion updateLightSources :: World -> World updateLightSources = tempLightSources %~ f where - f = mapMaybe (\b -> _tlsUpdate b b) + f = mapMaybe (\b -> updateTempLightSource (_tlsUpdate b) b) updateRadarBlips :: World -> World updateRadarBlips = radarBlips %~ mapMaybe updateRadarBlip diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 3ed5a4a07..dc0e84f71 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -47,11 +47,7 @@ flareCircleAt col alphax tranv = flares .:~ CircFlare explosionFlashAt :: Point2 -> World -> World -explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 intensityFunc (addZ 20 p) - where - intensityFunc x - | x < 10 = 1 / (10 - fromIntegral x) - | otherwise = 1 +explosionFlashAt p = tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 p) ptFlicker :: Particle -> World -> World ptFlicker pt