Add wall drawing capability (for shadows)

app/Main.hs

@@ -53,7 +53,9 @@ main = do
          \preData w -> --do render setparams w egFade
                       renderPicture' preData (_cameraRot w) (_cameraZoom w) 
                                              (_cameraPos w)
-                                             (_windowX w,_windowY w) (draw blank w)
+                                             (_windowX w,_windowY w) 
+                                            (wallsForGloom' w)
+                                            (draw blank w)
                       --renderPicture' preData (_windowX w,_windowY w) (Circle 5)
 --            renderPicture' preData 
 --                          (pictures [scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)]

shader/wallShadow.frag

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

shader/wallShadow.geom

@@ -9,17 +9,16 @@ void main()
 {
   vec2 posa = gl_in[0].gl_Position.xy;
   vec2 posb = gl_in[0].gl_Position.zw;
-  vec2 v = normalize( posb - posa);
+  vec2 posc = vBackPoss[0].xy;
-  vec2 off = vec2( -(v.y *0.2) 
+  vec2 posd = vBackPoss[0].zw;
-                 , v.x *0.2 );
 
-  gl_Position = vec4 (posa, 0 , 1);
+  gl_Position = vec4 (posa, -1 , 1);
   EmitVertex();
-  gl_Position = vec4 (posb, 0 , 1);
+  gl_Position = vec4 (posb, -1 , 1);
   EmitVertex();
-  gl_Position = vec4 (posa + off, 0 , 1);
+  gl_Position = vec4 (posc, -1 , 1);
   EmitVertex();
-  gl_Position = vec4 (posb + off, 0 , 1);
+  gl_Position = vec4 (posd, -1 , 1);
   EmitVertex();
 
   EndPrimitive();

src/Dodge/Rendering.hs

@@ -508,6 +508,18 @@ wallsForGloom w = map (\(x:y:_) -> (screenShift x,screenShift y)) $
     where screenShift x = zoom *.* rotateV (0 - _cameraRot w) (x -.- _cameraPos w)
           zoom = _cameraZoom w
 
+wallsForGloom' :: World -> [(Point2,Point2,Point2,Point2)]
+wallsForGloom' w = map (wallPairToFour . _wlLine) $ filter (not . _wlIsSeeThrough) 
+                                $ 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)
+          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'
+-- the ss transformation would possibly be better done using a matrix in the
+-- shader
+          zoom = _cameraZoom w
 
 lightsForGloom :: World -> [(Point2,Float,Float)]
 lightsForGloom w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)

src/Picture/Render.hs

@@ -247,8 +247,81 @@ threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float)
 threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
     (a:b:c:_) -> (a,b,c)
 
-renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO ()
+renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-renderPicture' pdata rot zoom (tranx,trany) (winx,winy) pic = do
+                    [(Point2,Point2,Point2,Point2)] -> Picture -> IO ()
+renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints pic = do
+    let firstIndex = 0
+
+    (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) 
+--        <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)  
+        <- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata)  
+                            (threePtrsVAO $ _textVAO pdata)
+                            (threePtrsVAO $ _circVAO pdata)
+                            (twoPtrsVAO $ _lineVAO pdata)
+                            (threePtrsVAO $ _arcVAO pdata)
+                   ) $ picToFTree pic
+
+    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
+        backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
+    pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
+    pokeTwoOff backPtr2 0  (winx,winy)
+    bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
+    textureBinding Texture2D $= Just (_textures pdata !! 1)
+    drawArrays Points (fromIntegral 0) (fromIntegral 1)
+    
+
+-- draw triangles
+    currentProgram $= Just (_basicShader pdata)
+    bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
+    bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
+    drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs)
+-- draw lines, don't need to change the program or vaos, just need to bind the
+-- vbos and draw
+    bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
+    bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata
+    drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs)
+-- draw circles
+    currentProgram $= Just (_circShader pdata)
+    uniform (_uniWinSize pdata) $= Vector2 winx winy
+    uniform (_csZoomUni pdata)  $= zoom
+    bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
+    bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
+    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs)
+-- draw arcs
+    currentProgram $= Just (_arcShader pdata)
+    uniform (_asWinUni pdata) $= Vector2 winx winy
+    uniform (_asZoomUni pdata)  $= zoom
+    bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
+    bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
+    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs)
+-- draw text
+    currentProgram $= Just (_textShader pdata)
+    bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
+    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
+
+renderPicture :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO ()
+renderPicture pdata rot zoom (tranx,trany) (winx,winy) pic = do
     let firstIndex = 0
 
     (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) 
@@ -303,6 +376,3 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) 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