Remove wall sight occlusion for lighting changes

shader/bezierQuad.frag

@@ -11,8 +11,8 @@ void main()
   float d = sqrt(boxOut.x) + sqrt(boxOut.y) - 1;
 //  float e = sqrt(f(x,wStart)) + sqrt(f(y,wEnd)) - 1.0;
   float e = sqrt(boxIn.x) + sqrt(boxIn.y) - 1.0;
-//  if ( d < 0 || e > 0) { discard; }
+  if ( d < 0 || e > 0) { discard; }
   fColor = vColor;
 //  if ( d < 0 || e > 0) { fColor = vec4(0,0,1,1); }
-  if ( d < 0 || e > 0) { fColor = vec4(0,0,1,1); }
+//  if ( d < 0 || e > 0) { fColor = vec4(0,0,1,1); }
 }

src/Dodge/Rendering.hs

@@ -70,7 +70,7 @@ worldPictures w
                         , ptPicts'
                         , afterPtPicts'
                         , wlPicts
-                        , wallShadows
+--                        , wallShadows
                         , smokeShadows
 --                        , itLabels
                         , ppLabels

src/Picture/Preload.hs

@@ -16,7 +16,7 @@ import Control.Lens
 import Foreign
 import Shader
 
-import Geometry (Point2)
+import Geometry (Point2,Point4)
 
 import qualified Control.Foldl as F
 
@@ -25,6 +25,7 @@ data RenderData = RenderData
     , _wallShadowShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader  :: FullShader ()
+    , _wallShader :: FullShader (Point2,Point4)
     , _listShaders :: [FullShader RenderType]
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
@@ -46,6 +47,8 @@ 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
+
     bslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Triangles pokeTriStrat
     lslist <- makeShader "basic"   [vert,frag]      [(0,3),(1,4)]       Lines     pokeLineStrat
     aslist <- makeShader "arc"     [vert,geom,frag] [(0,3),(1,4),(2,4)] Points    pokeArcStrat
@@ -88,6 +91,7 @@ preloadRender = do
         , _dummyPtr = dummyptr
         , _lightSourceShader = lsShad
         , _wallShadowShader  = wsShad
+        , _wallShader        = wlShad
         , _backgroundShader  = bgShad
         , _fullscreenShader  = fsShad
         , _spareFBO = fbo
@@ -141,6 +145,9 @@ 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]]]
+
 pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs
 pokeCharStrat _ = []
 

src/Picture/Render.hs

@@ -131,6 +131,19 @@ 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]
+
     resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
 
     endWallTicks <- SDL.ticks