Add lighting on walls, imperfect

src/Picture/Preload.hs

@@ -23,7 +23,7 @@ import qualified Control.Foldl as F
 data RenderData = RenderData
     { _lightSourceShader :: FullShader (Float,Float,Float,Float)
     , _wallShadowShader  :: FullShader (Point2,Point2)
-    , _wallLightShader  :: FullShader (Point3)
+    , _wallLightShader   :: FullShader (Point2,Point2)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader  :: FullShader ()
     , _wallShader :: FullShader (Point3,Point4)
@@ -48,8 +48,9 @@ preloadRender = do
     wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4)] Points pokeWPStrat
                 ["lightPos","perpMat","facesToDraw"]
 
-    wlLightShad <- makeShaderCustomUnis "wallLight" [vert,frag] [(0,3)] TriangleStrip pokeLightWallStrat
-                    ["lightPosRadLum"]
+    wlLightShad 
+         <- makeShaderCustomUnis "lightmapWall" [vert,geom,frag] [(0,4)] Points pokeWPStrat
+                    ["lightPos","perpMat","radLum"]
 
     wlShad <- makeShader "wall" [vert,frag] [(0,3),(1,4)] TriangleStrip pokeWlStrat
 

src/Picture/Render.hs

@@ -61,7 +61,18 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     clearDepth $= 1
     clear [ColorBuffer,DepthBuffer]
 
-    nWalls <- F.foldM (pokeShader (_wallShadowShader pdata)) wallPoints
+-- calculate perspective matrix
+    pmat <- (newMatrix RowMajor 
+                $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
+            ) :: IO (GLmatrix GLfloat)
+
+    nWallLights <- F.foldM (pokeShader $ _wallLightShader pdata) wallPoints
+    bindShaderBuffers [_wallLightShader pdata] [nWallLights]
+    currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
+    uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 1)
+            $= pmat
+
+    nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints
     bindShaderBuffers [_wallShadowShader pdata] [nWalls]
 
     let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
@@ -69,9 +80,6 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
     uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
             $= Vector2 viewFromx viewFromy  
-    pmat <- (newMatrix RowMajor 
-                $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
-            ) :: IO (GLmatrix GLfloat)
     uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 1)
             $= pmat
     uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 2)
@@ -80,6 +88,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     cullFace $= Nothing
     drawShader (_wallShadowShader pdata) nWalls
 
+
     depthMask $= Disabled
     blendFunc $= (Zero, OneMinusSrcAlpha)
 --    blendFuncSeparate    $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
@@ -114,14 +123,14 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
         bindShaderBuffers [_lightSourceShader pdata] [1]
         stencilFunc $= (Equal, 0, 255)
         drawShader (_lightSourceShader pdata) 1
-        
---        currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
---        uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata)
---            $= Vector4 x y r lum
---        cullFace $= Just Front
---        depthFunc $= Just Lequal
---        drawShader (_wallLightShader pdata) nLightWalls
 
+        currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
+        uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata)
+                $= Vector2 x y  
+        uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 2)
+                $= Vector2 r lum
+        drawShader (_wallLightShader pdata) nWallLights
+        
     depthMask $= Enabled
     cullFace $= Nothing
     stencilTest $= Disabled
@@ -176,42 +185,6 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     ticks4 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic
     bticks <- SDL.ticks
 
--- render walls
---    depthFunc $= Nothing
---    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
---    -- poke data
---    cullFace $= Just Back
---    let lights = map (\(x,y,r,g) -> ((x,y),(r,g,0,0))) lightPoints
---        wallPairs = map (\(a,b,_,_) -> [(a,(1,1,1,1)),(b,(1,1,1,1))]) wallPoints
---        f (x,y) = [(x,y,0),(x,y,0),(x,y,-1)]
---        g (x,y) = [(x,y,0),(x,y,-1),(x,y,-1)]
---        wp = concatMap (\(a,b,_,_) -> f a ++ g b) wallPoints
---        h p = (p,(1,0,0,1))
---        wp2 = ((200,200),(-200,200),(0,0),(0,0))
---        wp3 = ((-200,200),(-200,-200),(0,0),(0,0))
---    i <- F.foldM (pokeShader (_wallShader pdata)) $ concat $ mkShadFromWall <$> [wp2,wp3] <*> [(300,50,200,0)]
---
---    -- bind buffers
---    bindShaderBuffers [_wallShader pdata] [i]
---
---    -- draw call
---    drawShaders [_wallShader pdata] [i]
---    depthFunc $= Just Lequal
-
-------    blendFunc $= (One,Zero)
-------    let f (x,y) = (x,y,0)
-------        h (x,y) = (x,y,-1)
-------        g (a,b) = [f a,f a,h a,f b,h b,h b]
-------        wp = concatMap g [((200,200),(-200,200))]
-------    nLightWalls <- F.foldM (pokeShader (_wallLightShader pdata)) wp
-------    bindShaderBuffers [_wallLightShader pdata] [nLightWalls]
-------    currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
-------    uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata)
-------        $= Vector4 (0::Float) 0 200 0.5
-------    cullFace $= Just Front
-------    depthFunc $= Just Lequal
-------    drawShader (_wallLightShader pdata) nLightWalls
-
     resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
 
     endWallTicks <- SDL.ticks