First pass implementing exponentially fading lighting

app/Main.hs

@@ -55,6 +55,7 @@ main = do
                                              (_cameraPos w)
                                              (_windowX w,_windowY w) 
                                             (wallsForGloom' w)
+                                            (lightsForGloom' w)
                                             (draw blank w)
                       --renderPicture' preData (_windowX w,_windowY w) (Circle 5)
 --            renderPicture' preData 

shader/fadeCircle.frag

@@ -1,12 +1,15 @@
 #version 430 core
-in vec4 gColor;
+in vec2 cenPosT;
-in vec2 cenPosTrans;
+in vec2 gParams;
-in float gRad;
 out vec4 fColor;
 
 void main()
 {
   vec2 pos = gl_FragCoord.xy;
-  float dist = max(0 , 1 - 2 * distance(pos,cenPosTrans) / (gRad));
+  float dist = min(1 , 2*distance(pos,cenPosT) / (gParams.x));
-  fColor = vec4( gColor.xyz , pow(gColor.z*dist,2) );
+  //float c = pow(gParams.y*dist,2);
+  float c = pow(1-dist,2);
+  fColor = vec4( c,c,c ,c  );
+//  fColor = vec4( 1,0,0 ,  1);
+//  fColor = vec4( 1,0,0 , pow(dist,2) );
 }

shader/fadeCircle.geom

@@ -1,30 +1,39 @@
 #version 430 core
 layout (points) in;
 layout (triangle_strip, max_vertices = 4) out;
-in vec4 vColor [];
+in vec2 vParams [];
-in float vRad [];
+out vec2 gParams;
+out vec2 cenPosT;
+
 uniform vec2 winSize;
-out vec4 gColor;
+uniform float zoom;
-out float gRad;
+
-out vec2 cenPosTrans;
 void main()
 {
   vec3 cenPos = gl_in[0].gl_Position.xyz;
-  vec2 cenPosa = cenPos.xy + vec2 (1,1);
+  //cenPos = vec3 (0.5,0,0);
-  cenPosTrans = vec2 (cenPosa * winSize * 0.5);
+  gParams = vec2( vParams[0].x * zoom * 2, vParams[0].y);
-  gColor = vColor[0];
+  float gRad = gParams.x;
-  gRad = vRad[0];
 
-  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y);
+
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y + gRad/winSize.y, 0.9 , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, cenPos.z , 1);
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y + gRad/winSize.y, 0.9 , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  gl_Position = vec4 (cenPos.x + gRad/winSize.x, cenPos.y - gRad/winSize.y, 0.9 , 1);
   EmitVertex();
-  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, cenPos.z , 1);
+  gl_Position = vec4 (cenPos.x - gRad/winSize.x, cenPos.y - gRad/winSize.y, 0.9 , 1);
   EmitVertex();
 
+//  gl_Position = vec4 (0.5,0.5,0 , 1);
+//  EmitVertex();
+//  gl_Position = vec4 (0,0.5,0 , 1);
+//  EmitVertex();
+//  gl_Position = vec4 (0.5,0,0 , 1);
+//  EmitVertex();
+//  gl_Position = vec4 (0,0,0 , 1);
+//  EmitVertex();
 
   EndPrimitive();
-
 }

shader/fadeCircle.vert

@@ -1,12 +1,8 @@
 #version 430 core
-layout (location = 0) in vec3 position;
+layout (location = 0) in vec4 position;
-layout (location = 1) in vec4 color;
+out vec2 vParams;
-layout (location = 2) in float rad;
-out vec4 vColor;
-out float vRad;
 void main()
 {
-  gl_Position = vec4(position,1);
+  gl_Position = vec4(position.xy,0,1);
-  vColor = color;
+  vParams = position.zw;
-  vRad = rad;
 }

shader/wallShadow.frag

@@ -3,5 +3,5 @@ out vec4 fColor;
 
 void main()
 {
-  fColor = vec4 (0.9,0.5,0,1);
+  fColor = vec4 (0.9,0.5,0,0);
 }

shader/wallShadow.geom

@@ -1,6 +1,6 @@
 #version 430 core
 layout (points) in;
-layout (triangle_strip, max_vertices = 4) out;
+layout (triangle_strip, max_vertices = 10) out;
 
 in vec4 vBackPoss[];
 uniform vec2 lightPos;
@@ -12,13 +12,25 @@ void main()
   vec2 posc = vBackPoss[0].xy;
   vec2 posd = vBackPoss[0].zw;
 
-  gl_Position = vec4 (posa, -1 , 1);
+  gl_Position = vec4 (posa, 0 , 1);
   EmitVertex();
-  gl_Position = vec4 (posb, -1 , 1);
+  gl_Position = vec4 (posa + (200 * (posa - lightPos)), 0 , 1);
   EmitVertex();
-  gl_Position = vec4 (posc, -1 , 1);
+  gl_Position = vec4 (posb, 0 , 1);
   EmitVertex();
-  gl_Position = vec4 (posd, -1 , 1);
+  gl_Position = vec4 (posb + (200 * (posb - lightPos)), 0 , 1);
+  EmitVertex();
+  gl_Position = vec4 (posb + (200 * (posb - lightPos)), 0 , 1);
+  EmitVertex();
+  gl_Position = vec4 (posd, 0 , 1);
+  EmitVertex();
+  gl_Position = vec4 (posd, 0 , 1);
+  EmitVertex();
+  gl_Position = vec4 (posd + (200 * (posd - lightPos)), 0 , 1);
+  EmitVertex();
+  gl_Position = vec4 (posc, 0 , 1);
+  EmitVertex();
+  gl_Position = vec4 (posc + (200 * (posc - lightPos)), 0 , 1);
   EmitVertex();
 
   EndPrimitive();

src/Dodge/LightSources.hs

@@ -17,7 +17,7 @@ lightAt p i =
        ,_lsPos = p
        ,_lsDir = 0
        ,_lsRad = 300
-       ,_lsIntensity = 0.25
+       ,_lsIntensity = 0.5
        }
 
 basicLS = PutLS ls dec

src/Dodge/Rendering.hs

@@ -513,7 +513,7 @@ wallsForGloom' w = map (wallPairToFour . _wlLine) $ filter (not . _wlIsSeeThroug
                                 $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
 
     where wallPairToFour (x:y:_) = (ss x,ss y,ss $ x +.+ n,ss $ y+.+ n)
-            where n = 20 *.* (normalizeV $ vNormal $ y -.- x)
+            where n = 15 *.* (normalizeV $ vNormal $ y -.- x)
           ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
           ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
           ss = ss'' . ss'
@@ -521,6 +521,17 @@ wallsForGloom' w = map (wallPairToFour . _wlLine) $ filter (not . _wlIsSeeThroug
 -- shader
           zoom = _cameraZoom w
 
+lightsForGloom' :: World -> [(Point4)]
+lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
+    where getLS ls  = ( fst $ ssls ls, snd $ ssls ls,  _lsRad ls , _lsIntensity ls)
+          getTLS ls = ( fst $ sstls ls,snd $ sstls ls, _tlsRad ls, _tlsIntensity ls)
+          ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
+          ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
+          ss = ss'' . ss'
+          ssls = ss . _lsPos 
+          sstls = ss . _tlsPos 
+          zoom = _cameraZoom w
+
 lightsForGloom :: World -> [(Point2,Float,Float)]
 lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
     where getLS ls = (screenShift $ _lsPos ls, _lsRad ls * zoom, _lsIntensity ls)

src/Picture/Preload.hs

@@ -33,6 +33,7 @@ data PreloadData = PreloadData
     , _arcVAO  :: VAO
     , _backVAO :: VAO
     , _wallVAO :: VAO
+    , _fadeCircVAO :: VAO
     , _posVBO :: BufferObject
     , _colVBO :: BufferObject
     , _texVBO :: BufferObject
@@ -40,6 +41,9 @@ data PreloadData = PreloadData
     , _csZoomUni :: UniformLocation
     , _asWinUni :: UniformLocation
     , _asZoomUni :: UniformLocation
+    , _fcsWinUni  :: UniformLocation
+    , _fcsZoomUni :: UniformLocation
+    , _wssLightPos :: UniformLocation
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
     }
@@ -112,6 +116,8 @@ doPreload' = do
     asWinSizeUniLoc <- GL.uniformLocation as "winSize"
     asZoomUniLoc    <- GL.uniformLocation as "zoom"
     wssLightPosUniLoc   <- GL.uniformLocation wss "lightPos"
+    fcsWinSizeUniLoc <- GL.uniformLocation fcs "winSize"
+    fcsZoomUniLoc    <- GL.uniformLocation fcs "zoom"
 -- get uniform locations
 
 --setup vbos
@@ -164,6 +170,7 @@ doPreload' = do
     arcvao  <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
     backgroundvao <- setupVAO [(posVBO,0,4),(colVBO,1,2)]
     wallvao <- setupVAO [(posVBO,0,4),(colVBO,1,4)]
+    fadecircvao <- setupVAO [(posVBO,0,4)]
     
     return $ PreloadData
         { -- _charMap      = convertRGBA8 cmap
@@ -182,6 +189,7 @@ doPreload' = do
         , _lineVAO = linevao
         , _backVAO = backgroundvao
         , _wallVAO = wallvao
+        , _fadeCircVAO = fadecircvao
         , _posVBO = posVBO
         , _colVBO = colVBO
         , _texVBO = texVBO
@@ -191,6 +199,9 @@ doPreload' = do
         , _csZoomUni  = zoomUni
         , _asWinUni = asWinSizeUniLoc
         , _asZoomUni = asZoomUniLoc
+        , _wssLightPos = wssLightPosUniLoc
+        , _fcsWinUni = fcsWinSizeUniLoc
+        , _fcsZoomUni = fcsZoomUniLoc
         }
 
 vaoPointers :: VAO -> [Ptr Float]

src/Picture/Render.hs

@@ -248,8 +248,44 @@ threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
     (a:b:c:_) -> (a,b,c)
 
 renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2,Point2,Point2)] -> Picture -> IO ()
+                    [(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO ()
-renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints pic = do
+renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
+    depthFunc $= Just Lequal
+
+    bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
+    let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
+        wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
+        foldWalls n ((x,y),(z,w),(a,b),(c,d)) = do
+                pokeFourOff wallPtr  n (x,y,z,w)
+                pokeFourOff wallPtr2 n (a,b,c,d)
+                return $ n+1
+    nWalls <- foldM foldWalls 0 wallPoints 
+
+    forM_ lightPoints $ \(x,y,r,lum) -> do
+        cullFace $= Just Front
+        clear [DepthBuffer]
+        currentProgram $= Just (_wallShadowShader pdata)
+        bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
+        bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
+        uniform (_wssLightPos pdata)  $= Vector2 (x) (y)
+        blendFunc $= (Zero,One)
+        drawArrays Points (fromIntegral 0) (fromIntegral $ length wallPoints)
+        cullFace $= Nothing
+        currentProgram $= Just (_fadeCircleShader pdata)
+        bindVertexArrayObject $= Just (_vao $ _fadeCircVAO pdata)
+        let fadeCircPtr = (\(_,ptr,_) -> ptr) $ head $ _vaoBufferTargets $ _fadeCircVAO pdata
+        pokeFourOff fadeCircPtr 0 (x,y,r,lum)
+        bindArrayBuffers (1) $ _vaoBufferTargets $ _fadeCircVAO pdata
+        uniform (_fcsWinUni pdata) $= Vector2 winx winy
+        uniform (_fcsZoomUni pdata)  $= zoom
+    -- to refactor: put these uniforms in a ubo
+        blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
+        drawArrays Points (fromIntegral 0) (fromIntegral 1)
+
+-- set drawing for on top
+        blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
+        clear [DepthBuffer]
+
     let firstIndex = 0
 
     (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) 
@@ -263,18 +299,6 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints pic = do
 
     depthFunc $= Just Less
 
-    currentProgram $= Just (_wallShadowShader pdata)
-    bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
-    let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
-        wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
-        foldWalls n ((x,y),(z,w),(a,b),(c,d)) = do
-                pokeFourOff wallPtr  n (x,y,z,w)
-                pokeFourOff wallPtr2 n (a,b,c,d)
-                return $ n+1
-    nWalls <- foldM foldWalls 0 wallPoints 
-    bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
-    drawArrays Points (fromIntegral 0) (fromIntegral $ length wallPoints)
-    
     currentProgram $= Just (_backShader pdata)
     bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
     let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
@@ -316,6 +340,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints pic = do
     bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
     textureBinding Texture2D $= Just (_textures pdata !! 0)
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
+    
 
 bufferOffset :: Integral a => a -> Ptr b
 bufferOffset = plusPtr nullPtr . fromIntegral