Improve shadows for static walls

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