Working shadows from foreground, not optimised

shader/lighting/lineShadow.geom

@@ -24,9 +24,4 @@ void main()
     }
     {
     }
-    //gl_Position = vec4 (0,0,-0.5,1); EmitVertex();
-    //gl_Position = vec4 (1,0,-0.5,1); EmitVertex();
-    //gl_Position = vec4 (1,1,1,1); EmitVertex();
-    //gl_Position = vec4 (0,1,1,1); EmitVertex();
-    //EndPrimitive();
 }

src/Dodge/Render.hs

@@ -63,8 +63,9 @@ doDrawing pdata w = do
 
     -- store floor position into buffer
     let addC (xx,yy) = (xx,yy,0)
-    nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) [Render3 
+    nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) 
-        $ polyToTris $ map addC $ screenPolygon w ]
+        $ [Render3 $ polyToTris $ map addC $ screenPolygon w ]
+        ++ concatMap polyToGeoRender (foregroundPics w)
     bindShaderBuffers [_lightingSurfaceShader pdata] [nsurfVs]
 
     depthFunc $= Just Less

src/Dodge/Room/Foreground.hs

@@ -48,9 +48,9 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
         ]
     yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
-highPipe :: Point2 -> Point2 -> [Polyhedra]
+highPipe :: Float -> Point2 -> Point2 -> [Polyhedra]
-highPipe x@(xx,xy) y = 
+highPipe h x@(xx,xy) y = 
-    [ Polyhedron . map (map ( (,orange) . (+.+.+ (xx,xy,50)))) 
+    [ Polyhedron . map (map ( (,orange) . (+.+.+ (xx,xy,h)))) 
         $ boxABC (a,b,0) (a',b',0) (0,0,10)
 --    ,verticalPipe 5 orange x 0 100 
 --    ,verticalPipe 5 orange y 0 100 

src/Dodge/Room/Start.hs

@@ -22,7 +22,9 @@ startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
-    let fground = sPS (0,0) 0 $ PutForeground $ highPipe (0,h/3) (w, h/3)
+    let fground = sPS (0,0) 0 $ PutForeground $ 
+            highPipe 80 (0,h/3) (w, 2*h/3)
+            ++ highPipe 20 (0,2*h/3) (w, h/3)
 --            , girderV cola 10 (0,3*h/4) (w, 3*h/4)
 --            , girder colb 5 (0,5*h/8) (w, 5*h/8)
     treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))

src/Polyhedra.hs

@@ -1,5 +1,6 @@
 module Polyhedra
     where
+import Geometry
 import Geometry.Data
 import Geometry.Vector3D
 import Polyhedra.Data
@@ -90,5 +91,9 @@ polysToPic = pictures . concatMap polyToPics
 polyToEdges :: Polyhedra -> [(Point3,Point3,Point3,Point3)]
 polyToEdges = constructEdges . map (map fst) . _pyFaces
 
+-- rendering for silhouette
 polyToRender :: Polyhedra -> [RenderType]
 polyToRender = map Render3 . map flat4 . polyToEdges
+-- rendering for shape
+polyToGeoRender :: Polyhedra -> [RenderType]
+polyToGeoRender = map (Render3 . polyToTris . map fst) . _pyFaces

src/Render.hs

@@ -6,6 +6,7 @@ import Shader.Poke
 --import MatrixHelper
 import Data.Preload.Render
 import Picture.Data
+import Picture.Tree
 --import Geometry
 import Geometry.Data
 import Polyhedra.Data
@@ -70,7 +71,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 
-    -- store foreground geometry into buffer
+    -- store foreground silhouette geometry into buffer
     nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) (concatMap polyToRender fpics)
     bindShaderBuffers [_lightingLineShadowShader pdata] [nSils]
 
@@ -86,11 +87,11 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
     drawShader (_lightingOccludeShader pdata) nWalls
 
     cullFace $= Nothing
+
 ---- draw foreground elements to set z buffer
---    forM_ (_pictureShaders pdata) $ \shad -> do
+    --_ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic fpics)
---        currentProgram $= Just (_shaderProgram shad)
+    currentProgram $= Just (_shaderProgram $ _lightingSurfaceShader pdata)
---        uniform (_shaderUniforms shad !! 4) $= pmat
+    drawShader (_lightingSurfaceShader pdata) nWallLights
---    _ <- renderFoldable pdata $ picToLTree (Just 0) fpics
 
 -- for each of the lights: 
 -- stencil out the walls from this light's point of view
@@ -99,8 +100,10 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
     depthMask $= Disabled
     blendFunc $= (Zero, OneMinusSrcAlpha)
     stencilTest $= Enabled
+    --depthFunc $= Just Less
     forM_ lightPoints $ \((x,y,z),r,lum) -> do
 -- stencil out walls
+        depthFunc $= Just Less
         colorMask $= Color4 Disabled Disabled Disabled Disabled
         clear [StencilBuffer]
         cullFace $= Just Back
@@ -124,6 +127,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
 
         currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
         drawShader (_lightingLineShadowShader pdata) nSils
+        depthFunc $= Just Lequal
 -- draw floor light circles
         cullFace $= Nothing
         colorMask $= Color4 Disabled Disabled Disabled Enabled