Draw walls using perspective divide

src/Picture/Render.hs

@@ -44,6 +44,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     setShaderUniforms rot zoom (tranx,trany) (winx,winy) 
         ( (extractProgAndUnis $ _lightSourceShader pdata) 
         : (extractProgAndUnis $ _wallShadowShader pdata) 
+        : (extractProgAndUnis $ _wallShader pdata) 
         : (extractProgAndUnis $ _backgroundShader pdata) 
         : (map extractProgAndUnis $ _listShaders pdata)
         )
@@ -131,18 +132,22 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
     ticks4 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic
     bticks <- SDL.ticks
 
----- render walls
---    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
---    -- poke data
---    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
---    i <- F.foldM (pokeShader (_wallShader pdata)) $ concat $ (:) <$> lights <*> wallPairs
---
---    -- bind buffers
---    bindShaderBuffers [_wallShader pdata] [i]
---
---    -- draw call
---    drawShaders [_wallShader pdata] [i]
+-- render walls
+    blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
+    -- poke data
+    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))
+    i <- F.foldM (pokeShader (_wallShader pdata)) $ map h wp
+
+    -- bind buffers
+    bindShaderBuffers [_wallShader pdata] [i]
+
+    -- draw call
+    drawShaders [_wallShader pdata] [i]
 
     resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)