Implement textures on walls, windows don't look great yet

app/Main.hs

@@ -57,7 +57,8 @@ main = do
                                             (_cameraRot w) (_cameraZoom w) 
                                             (_cameraPos w)
                                             (_windowX w,_windowY w) 
-                                            (wallsForGloom w)
+                                            (wallsPointsAndCols w)
+                                            (wallsWindows w)
                                             (lightsForGloom' w)
                                             (_cameraCenter w)
                                             (worldPictures w)

src/Dodge/LevelGen/AutoDoor.hs

@@ -40,10 +40,10 @@ mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
                                , [pru,prd]
                                , [prd,prrd,pr,pr]
                                ]
-    where norm = 15.1 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
+    where norm = 10 *.* errorNormalizeV 49 ( vNormal (pr -.- pl))
-                    -- .1 hack, there was flickering
           hw = 0.5 *.* (pl +.+ pr)
-          parallel = 20 *.* normalizeV (pl -.- pr)
+          --parallel = 15 *.* normalizeV (pl -.- pr)
+          parallel = 0.51 *.* (pl -.- pr)
           plu = pl +.+ norm
           pld = pl -.- norm
           pru = pr +.+ norm

src/Dodge/Rendering.hs

@@ -29,9 +29,9 @@ fixedCoordPictures :: World -> Picture
 fixedCoordPictures w = pictures
              [ scaler $ hudDrawings w
              , scaler $ onLayer MenuLayer menuScreen
-             , onLayer InvLayer $ closeObjectTexts w
+             , setDepth 1 $ closeObjectTexts w
              ]
-    where scaler = scale (2 / _windowX w) (2 / _windowY w)
+    where scaler = setDepth 1 . scale (2 / _windowX w) (2 / _windowY w)
           menuScreen :: Picture
           menuScreen = case _menuState w of
                         InGame -> blank 
@@ -241,7 +241,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
         
 drawWallFloor :: Wall -> Picture
 drawWallFloor wl = if _wlIsSeeThrough wl
-                   then onLayerL [levLayer WlLayer] $ color c $ polygon [x,x +.+ n2,y+.+n2, y]
+                   then onLayerL [0] $ color c $ polygon [x,x +.+ n2,y+.+n2, y]
                    else blank
     where 
         (x:y:_) = _wlLine wl
@@ -439,6 +439,22 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
                     scale 0.2 0.2 $ text $ reverse $ take 5 $ (++ repeat ' ') $ reverse $ show
                     $ _crHP $ _creatures w IM.! n
 
+wallsPointsAndCols :: World -> [((Point2,Point2),Point4)]
+wallsPointsAndCols w = map f . filter (not . _wlIsSeeThrough) . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
+    where linePairs (x:y:_) = (x,y)
+          f wl = (linePairs $ _wlLine wl, _wlColor wl)
+
+wallsWindows :: World -> [((Point2,Point2),Point4)]
+wallsWindows w = map f . filter _wlIsSeeThrough . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
+    where linePairs (x:y:_) = (x,y)
+          f wl = (linePairs $ _wlLine wl, _wlColor wl)
+
+wallsForShadows :: World -> [(Point2,Point2)]
+wallsForShadows w = map (linePairs . _wlLine) 
+                        . filter (not . _wlIsSeeThrough)
+                        . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
+    where linePairs (x:y:_) = (x,y)
+
 wallsForGloom :: World -> [((Point2,Point2),Point4)]
 wallsForGloom w = map f $ filter (not . _wlIsSeeThrough)
                         $ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w

src/Picture/Render.hs

@@ -41,10 +41,10 @@ setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
         : (map extractProgAndUnis $ _listShaders pdata)
         )
 
-renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
+renderPicture' :: RenderData -> Float -> Float -> Point2 -> Point2 ->
-                    [((Point2,Point2),Point4)] -> [Point4] ->
+                    [((Point2,Point2),Point4)] -> [((Point2,Point2),Point4)] -> [Point4] ->
                     (Float,Float) -> Picture -> IO (Word32,Word32)
-renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol lightPoints
+renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol windowPoints lightPoints
                     viewFroms@(viewFromx,viewFromy) pic = do
     let wallPoints = map fst wallPointsCol
     startTicks <- SDL.ticks
@@ -67,6 +67,8 @@ renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol
 
     renderWalls pdata wallPointsCol pmat
 
+    renderWalls pdata windowPoints pmat
+
 -- reset blend so that light map doesn't apply
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
     renderFoldable pdata $ picToLTree (Just 1) pic
@@ -120,7 +122,6 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 2)
             $= (0 :: Float)
     cullFace $= Just Back
-    cullFace $= Nothing
     drawShader (_wallShadowShader pdata) nWalls