Set up wall rendering with textures

app/Main.hs

@@ -62,10 +62,7 @@ main = do
                                             (_cameraCenter w)
                                             (worldPictures w)
                       blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
-                      renderFoldable (_renderData preData) (_cameraRot w) (_cameraZoom w) (_cameraPos w)
+                      renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
-                                            (_windowX w,_windowY w) 
-                                            --(picToLTree (Just 1) $ fixedCoordPictures w)
-                                            (picToLTree Nothing $ fixedCoordPictures w)
                       endRenderTicks <- SDL.ticks
                       playSoundQueue (_soundData preData) (_soundQueue w)
                       newSoundData <- playAndUpdate (_sounds w) (_soundData preData)

src/Dodge/Rendering.hs

@@ -439,10 +439,11 @@ 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
 
-wallsForGloom :: World -> [(Point2,Point2)]
+wallsForGloom :: World -> [((Point2,Point2),Point4)]
-wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
+wallsForGloom 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)
 
 lightsForGloom' :: World -> [(Point4)]
 lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)

src/Picture/Preload.hs

@@ -21,7 +21,7 @@ data RenderData = RenderData
     { _lightSourceShader :: FullShader (Float,Float,Float,Float)
     , _wallShadowShader  :: FullShader (Point2,Point2)
     , _wallLightShader   :: FullShader (Point2,Point2)
-    , _wallFaceShader    :: FullShader (Point2,Point2,Point4)
+    , _wallFaceShader    :: FullShader ((Point2,Point2),Point4)
     , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
     , _fullscreenShader  :: FullShader ()
     , _listShaders :: [FullShader RenderType]
@@ -155,8 +155,8 @@ frag = FragmentShader
 pokeWPStrat :: (Point2,Point2) -> [[[Float]]]
 pokeWPStrat ((x,y),(z,w)) = [[[x,y,z,w]]]
 
-pokeWPColStrat :: (Point2,Point2,Point4) -> [[[Float]]]
+pokeWPColStrat :: ((Point2,Point2),Point4) -> [[[Float]]]
-pokeWPColStrat ((x,y),(z,w),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]]
+pokeWPColStrat (((x,y),(z,w)),(r,g,b,a)) = [[[x,y,z,w],[r,g,b,a]]]
 
 pokeBGStrat :: a -> [[[Float]]]
 pokeBGStrat = const []

src/Picture/Render.hs

@@ -41,37 +41,40 @@ setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
         : (map extractProgAndUnis $ _listShaders pdata)
         )
 
-createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2)] -> [Point4] ->
-                    (Float,Float) -> Picture -> IO ()
-createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
-                    (viewFromx,viewFromy) pic = do
-    return ()
-
 renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2)] -> [Point4] ->
+                    [((Point2,Point2),Point4)] -> [Point4] ->
                     (Float,Float) -> Picture -> IO (Word32,Word32)
-renderPicture' pdata rot zoom trans wins wallPoints lightPoints
+renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol lightPoints
-                    viewFroms pic = do
+                    viewFroms@(viewFromx,viewFromy) pic = do
+    let wallPoints = map fst wallPointsCol
     startTicks <- SDL.ticks
     setCommonUniforms pdata rot zoom trans wins
-    renderPicture pdata rot zoom trans wins wallPoints lightPoints viewFroms pic
-    endTicks <- SDL.ticks
-    return (startTicks, endTicks - startTicks)
 
-renderPicture :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
-                    [(Point2,Point2)] -> [Point4] ->
-                    (Float,Float) -> Picture -> IO (Word32,Word32)
-renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
-                    (viewFromx,viewFromy) pic = do
-    wallPokeStart <- SDL.ticks
-
--- setting the depth function to less, instead of lequal, 
--- seems to stop a lot of unecessary drawing
--- of wall shadows when creating the light map
     depthFunc $= Just Less
 
--- draw lightmap
+-- calculate perspective matrix
+    pmat <- (newMatrix RowMajor 
+                $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
+            ) :: IO (GLmatrix GLfloat)
+
+    createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
+    ticksAfterLighting <- SDL.ticks
+    renderBackground pdata rot zoom trans wins
+    renderWalls pdata wallPointsCol pmat
+    renderPicture pdata pic
+    endTicks <- SDL.ticks
+    return (ticksAfterLighting, endTicks - startTicks)
+
+renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO ()
+renderWalls pdata wps pmat = do
+    n <- F.foldM (pokeShader $ _wallFaceShader pdata) wps
+    return ()
+
+createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
+                    [(Point2,Point2)] -> [Point4] ->
+                    (Float,Float) -> GLmatrix GLfloat -> IO ()
+createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
+                    (viewFromx,viewFromy) pmat = do
 
     bindFramebuffer Framebuffer $= (_spareFBO pdata)
     clearColor $= Color4 0 0.5 0 1
@@ -79,11 +82,6 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     clearDepth $= 1
     clear [ColorBuffer,DepthBuffer]
 
--- calculate perspective matrix
-    pmat <- (newMatrix RowMajor 
-                $ perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy)
-            ) :: IO (GLmatrix GLfloat)
-
     nWallLights <- F.foldM (pokeShader $ _wallLightShader pdata) wallPoints
     bindShaderBuffers [_wallLightShader pdata] [nWallLights]
     currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
@@ -171,14 +169,16 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
 
     blend $= Enabled
 
--- draw picture on top of light/shadow map
+renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
+renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do
+    depthFunc $= Just Less
+
 -- set drawing for on top
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
     clear [DepthBuffer]
 
 -- draw background
     bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
-    depthFunc $= Just Less
 
     currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
     bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
@@ -189,34 +189,28 @@ renderPicture pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     textureBinding Texture2D $= (fmap _textureObject $ _shaderTexture $ _backgroundShader pdata)
     drawArrays Points (fromIntegral 0) (fromIntegral 1)
 
+renderPicture :: RenderData -> Picture -> IO ()
+renderPicture pdata pic = do
+
     depthFunc $= Just Lequal
 
 -- draw layer 0
-    ticks2 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 0) pic
+    ticks2 <- renderFoldable pdata $ picToLTree (Just 0) pic
                                                         --((picToAlt 0 pic) :: [RenderType])
 -- reset blend so that light map doesn't apply
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
-    ticks3 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 1) pic
+    ticks3 <- renderFoldable pdata $ picToLTree (Just 1) pic
 -- set drawing for on top
     aticks <- SDL.ticks
     blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
-    ticks4 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic
+    ticks4 <- renderFoldable pdata $ picToLTree (Just 2) pic
     bticks <- SDL.ticks
 
     resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
 
-    endWallTicks <- SDL.ticks
-    --return (ticksAfterL, ticks2+ticks3+ticks4, endWallTicks - startWallTicks)
-    ticksE <- SDL.ticks
-    --return (ticksAfterL, ticksE - ticksS)
-    --return (ticksAfterL, ticks2 + ticks3 + ticks4)
-    return (ticksAfterL, wallPokeEnd - wallPokeStart)
 
-----------------end renderPicture'
+renderFoldable :: Foldable f => RenderData -> f RenderType -> IO Word32
-
+renderFoldable pdata tree = do
-renderFoldable :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
-                    -> f RenderType -> IO Word32
-renderFoldable pdata rot zoom (tranx,trany) (winx,winy) tree = do
     pokeStartTicks <- SDL.ticks
 
     let slist = _listShaders pdata