Draw walls using perspective divide

shader/wall.frag

@@ -0,0 +1,9 @@
+#version 430 core
+in vec4 vParams;
+out vec4 fColor;
+
+void main()
+{
+  fColor = vec4 (0.9,0.5,0,1);
+  fColor = vParams;
+}

shader/wall.geom

@@ -0,0 +1,31 @@
+#version 430 core
+layout (triangles) in;
+layout (triangle_strip, max_vertices = 4) out;
+
+in vec4 vParams[];
+
+uniform mat4 worldMat;
+
+vec2 lightPos = gl_in[0].gl_Position.xy;
+vec2 cornerA  = gl_in[1].gl_Position.xy;
+vec2 cornerB  = gl_in[2].gl_Position.xy;
+
+void main()
+{
+    gl_Position = worldMat * vec4(cornerA, 1, 1 );
+    EmitVertex();
+
+    gl_Position = worldMat * (vec4(cornerA, 10, 1 ) + (20,20,0,0));
+    gl_Position = vec4(1,0, 10, 1 );
+    EmitVertex();
+
+    gl_Position = worldMat * vec4(cornerB, 0, 1 );
+    gl_Position = vec4(0,1, -10, 1 );
+    EmitVertex();
+
+    gl_Position = worldMat * (vec4(cornerB, 0, 1 ) + (20,20,0,0));
+    gl_Position = vec4(1,1, 10, 1 );
+    EmitVertex();
+
+    EndPrimitive();
+}

shader/wall.vert

@@ -0,0 +1,18 @@
+#version 430 core
+layout (location = 0) in vec3 pos;
+layout (location = 1) in vec4 params;
+
+out vec4 vParams;
+uniform mat4 worldMat;
+
+mat4 perspective =  
+    mat4 (1,0,0,0
+         ,0,1,0,0
+         ,0,0,1,1
+         ,0,0,0,1
+         ) ;
+void main()
+{
+  gl_Position = perspective * worldMat * vec4(pos.xyz, 1);
+  vParams = params;
+}

src/Picture/Preload.hs

@@ -16,7 +16,7 @@ import Control.Lens
 import Foreign
 import Shader
 
-import Geometry (Point2,Point4)
+import Geometry (Point2,Point3,Point4)
 
 import qualified Control.Foldl as F
 
@@ -25,7 +25,7 @@ data RenderData = RenderData
     , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader  :: FullShader ()
-    , _wallShader :: FullShader (Point2,Point4)
+    , _wallShader :: FullShader (Point3,Point4)
     , _listShaders :: [FullShader RenderType]
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
@@ -47,7 +47,7 @@ preloadRender = do
     wsShad <- makeShaderCustomUnis "wallShadow" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPStrat
                 ["lightPos"]
 
-    wlShad <- makeShader "wall" [vert,geom,frag] [(0,2),(1,4)] Triangles pokeWlStrat
+    wlShad <- makeShader "wall" [vert,frag] [(0,3),(1,4)] TriangleStrip pokeWlStrat
 
     bslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
     lslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
@@ -145,8 +145,8 @@ pokeTriStrat :: RenderType -> [[[Float]]]
 pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
 pokeTriStrat _ = []
 
-pokeWlStrat :: (Point2,Point4) -> [[[Float]]]
-pokeWlStrat ((x,y),(r,g,b,a)) = [[[x,y],[r,g,b,a]]]
+pokeWlStrat :: (Point3,Point4) -> [[[Float]]]
+pokeWlStrat ((x,y,z),(r,g,b,a)) = [[[x,y,z],[r,g,b,a]]]
 
 pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs
 pokeCharStrat _ = []

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)