Reorganise wall placements

2021-11-17 12:35:05 +00:00
parent bcdf0e643c
commit 5949ad2b3d
13 changed files with 32 additions and 31 deletions
@@ -0,0 +1,61 @@
+module Dodge.LightSource
+    ( tLightTimedIntensity
+    , tLight
+    , lightAt
+    , colorLightAt
+    )
+    where
+import Dodge.Data
+import Geometry.Data
+import Dodge.Default
+
+import Control.Lens
+
+colorLightAt :: Point3 -> Point3 -> Int -> LightSource
+colorLightAt col pos i = 
+    LS {_lsID = i
+       ,_lsPos = pos
+       ,_lsDir = 0
+       ,_lsRad = 700
+       ,_lsIntensity = col
+       ,_lsPict = defLSPic
+       }
+
+lightAt :: Point3 -> Int -> LightSource
+lightAt = colorLightAt 0.75
+
+tLightTimedIntensity :: Int -> Float -> (Int -> Float) -> Point2 -> TempLightSource
+tLightTimedIntensity t rmax intensityF (V2 x y) = TLS 
+    { _tlsPos = V3 x y 0
+    , _tlsRad = rmax
+    , _tlsIntensity = f $ intensityF t
+    , _tlsUpdate = upF
+    , _tlsTime = t
+    }
+  where
+    upF _ tls 
+        | _tlsTime tls <= 0 = Nothing
+        | otherwise         = Just $ tls    
+            & tlsTime -~ 1
+            & tlsIntensity .~ f (intensityF (_tlsTime tls) )
+    f x' = V3 x' x' x'
+
+tLight
+    :: Int 
+    -> Float -- ^ maximal radius
+    -> Point3
+    -> Point3 
+    -> TempLightSource
+tLight t rmax col (V3 x y z) = TLS 
+    { _tlsPos = V3 x y z
+    , _tlsRad = rmax
+    , _tlsIntensity = col
+    , _tlsUpdate = upF
+    , _tlsTime = t
+    }
+  where
+    upF _ tls 
+        | _tlsTime tls <= 0 = Nothing
+        | otherwise         = Just $ tls    
+            & tlsTime -~ 1
+