Improve shadows for static walls

app/Main.hs

@@ -59,7 +59,7 @@ main = do
                                             (_cameraRot w) (_cameraZoom w) 
                                             (_cameraPos w)
                                             (_windowX w,_windowY w) 
-                                            (wallsForGloom' w)
+                                            (wallsForGloom w)
                                             (lightsForGloom' w)
                                             (worldPictures w)
                       blendFunc $= (SrcAlpha,OneMinusSrcAlpha)

shader/wallShadow.geom

@@ -1,29 +1,47 @@
 #version 430 core
 layout (points) in;
-layout (triangle_strip, max_vertices = 4) out;
+layout (triangle_strip, max_vertices = 8) out;
 
-//in vec4 vBackPoss[];
+in vec4 vBackPoss[];
 uniform vec2 lightPos;
 uniform mat4 worldMat;
 
+void emitLine (vec2 pa)
+{
+    gl_Position = vec4 (pa, 0, 1);
+    EmitVertex();
+    gl_Position = vec4 (pa + (200 * (pa - lightPos)), 0 , 1);
+    EmitVertex();
+}
+
+float isLHS (vec2 startV, vec2 testV)
+{
+    return sign( -startV.x * testV.y + startV.y * testV.x);
+}
+
 void main()
 {
-  vec4 posaa = worldMat * vec4(gl_in[0].gl_Position.xy, 0 ,1);
-  vec4 posba = worldMat * vec4(gl_in[0].gl_Position.zw, 0 ,1);
-  vec2 posa = posaa.xy;
-  vec2 posb = posba.xy;
+  vec4 frontL4 = worldMat * vec4(gl_in[0].gl_Position.xy, 0 ,1);
+  vec4 frontR4 = worldMat * vec4(gl_in[0].gl_Position.zw, 0 ,1);
+  vec2 frontL = frontL4.xy;
+  vec2 frontR = frontR4.xy;
+  vec4 backR4 = worldMat * vec4(vBackPoss[0].xy, 0 ,1);
+  vec4 backL4 = worldMat * vec4(vBackPoss[0].zw, 0 ,1);
+  vec2 backL = backL4.xy;
+  vec2 backR = backR4.xy;
 
-//  vec2 posc = vBackPoss[0].xy;
-//  vec2 posd = vBackPoss[0].zw;
-
-  gl_Position = vec4 (posb, 0 , 1);
-  EmitVertex();
-  gl_Position = vec4 (posb + (200 * (posb - lightPos)), 0 , 1);
-  EmitVertex();
-  gl_Position = vec4 (posa, 0 , 1);
-  EmitVertex();
-  gl_Position = vec4 (posa + (200 * (posa - lightPos)), 0 , 1);
-  EmitVertex();
+  if (isLHS( lightPos - frontL, frontR - frontL) < 0)
+  {
+  emitLine (backL);
+  emitLine (frontL);
+  emitLine (frontR);
+  emitLine (backR);
+  }
+  else
+  {
+  emitLine (backR);
+  emitLine (backL);
+  }
 
   EndPrimitive();
 }

shader/wallShadow.vert

@@ -1,8 +1,8 @@
 #version 430 core
 layout (location = 0) in vec4 poss;
-//layout (location = 1) in vec4 backPoss;
+layout (location = 1) in vec4 backPoss;
 
-//out vec4 vBackPoss;
+out vec4 vBackPoss;
 
 //uniform vec2 winSize;
 //uniform float zoom;
@@ -13,5 +13,5 @@ layout (location = 0) in vec4 poss;
 void main()
 {
   gl_Position = poss;
-//  vBackPoss = backPoss;
+  vBackPoss = backPoss;
 }

src/Dodge/LevelGen.hs

@@ -33,7 +33,7 @@ import qualified Data.IntMap.Strict as IM
 import qualified Data.Set as S
 import qualified Data.Map as M
 
-import Data.Graph.Inductive
+import Data.Graph.Inductive hiding ((&))
 import Data.Graph.Inductive.NodeMap
 import Data.Tree
 -- }}}
@@ -563,9 +563,12 @@ autoDoorPane trigL n [a,b] [a',b'] = AutoDoor
              | otherwise = flip (foldr changeZonedWall') zoneps
                            $ over walls (IM.adjust closeDoor n) w
         mvP !ep !p = mvPointTowardAtSpeed 2 ep p
+        moveToward :: [Point2] -> Wall -> Wall
+        moveToward ps w = w & wlLine %~ zipWith mvP ps
         openDoor :: Wall -> Wall
-        openDoor wl = case _wlLine wl of
-                        ((!pa):(!pb):_) -> wl {_wlLine = [mvP a' pa, mvP b' pb]}
+--        openDoor wl = case _wlLine wl of
+--                        ((!pa):(!pb):_) -> wl {_wlLine = [mvP a' pa, mvP b' pb]}
+        openDoor = moveToward [a',b']
         closeDoor :: Wall -> Wall
         closeDoor wl = case _wlLine wl of
                         ((!pa):(!pb):_) -> wl {_wlLine = [mvP a pa, mvP b pb]}

src/Dodge/Rendering.hs

@@ -318,9 +318,11 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
         
 
 drawWall :: Wall -> Drawing
+drawWall (Wall {_wlIsSeeThrough = False, _wlLine = ps, _wlColor = c}) 
+        = onLayerL [levLayer WlLayer, 2] $ color c $ polygon $ ps
 drawWall wl = case _wlDraw wl of
-        Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon $ _wlLine wl
-        --Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon [x,x +.+ n2,y +.+ n2, y]
+--        Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon $ _wlLine wl
+        Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon [x,x +.+ n2,y +.+ n2, y]
         Just d -> d wl
     where 
         (x:y:_) = _wlLine wl
@@ -560,6 +562,12 @@ displayHP n w = translate (halfWidth w-70) (halfHeight w-40) $
 
 testPic w = blank
 
+wallsForGloom :: World -> [(Point2,Point2,Point2,Point2)]
+wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
+                        $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
+    where linePairs (x:y:z:w:_) = (x,y,z,w)
+          linePairs (x:y:_) = (x,y,x,y)
+
 wallsForGloom' :: World -> [(Point2,Point2)]
 wallsForGloom' w = map (wallPairBack . _wlLine) $ filter (not . _wlIsSeeThrough) 
                                 $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w

src/Loop.hs

@@ -96,8 +96,8 @@ doLoop setup window startWorld
             endSimTicks <- ticks
             performGC
             endLoopTicks <- ticks -- it might be better to use System.Clock (monotonic)
-            let delay = max 0 (10 + fromIntegral startLoopTicks - fromIntegral endLoopTicks)
-            threadDelay (delay * 1000)
+            let delay = max 0 (20 + fromIntegral startLoopTicks - fromIntegral endLoopTicks)
+            threadDelay (delay * 1000 )
             endTime <- ticks
             let newNewParams = newParams & idleTime +~ (endTime - endLoopTicks)
                                          & gcTime +~ (endLoopTicks - endSimTicks)

src/Picture/Preload.hs

@@ -34,7 +34,6 @@ data RenderData = RenderData
     , _backVAO :: VAO
     , _wallVAO :: VAO
     , _fadeCircVAO :: VAO
-    , _texVBO :: BufferObject
     , _wssLightPos :: UniformLocation
     , _dummyVBO :: BufferObject
     , _dummyPtr :: Ptr Float
@@ -150,7 +149,7 @@ preloadRender = do
     circvao <- setupVAO [(0,3),(1,4),(2,1)]
     arcvao  <- setupVAO [(0,3),(1,4),(2,4)]
     backgroundvao <- setupVAO [(0,4),(1,2)]
-    wallvao <- setupVAO [(0,4)]--,(colVBO,1,4)]
+    wallvao <- setupVAO [(0,4),(1,4)]
     fadecircvao <- setupVAO [(0,4)]
     
     return $ RenderData

src/Picture/Render.hs

@@ -381,7 +381,7 @@ threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
 
 
 renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
+                    [(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
 renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
     wallPokeStart <- SDL.ticks
 
@@ -429,11 +429,11 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
 -- draw lightmap
     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)) = do
+        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)
 --                pokeElemOff (_dummyPtr pdata) n (fromIntegral n)
---                pokeFourOff wallPtr2 n (a,b,c,d)
+                pokeFourOff wallPtr2 n (a,b,c,d)
                 return $ n+1
     nWalls <- foldM foldWalls 0 wallPoints 
     bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata