Implement low res shadows

src/Picture/Render.hs

@@ -25,17 +25,12 @@ import Data.Maybe (fromJust)
 import qualified Data.IntMap.Strict as IM
 import qualified SDL
 
-
-renderWalls :: RenderData -> [((Point2,Point2),Point4)] -> GLmatrix GLfloat -> IO ()
-renderWalls pdata wps pmat = do
-    n <- F.foldM (pokeShader $ _wallFaceShader pdata) wps
-    bindShaderBuffers [_wallFaceShader pdata] [n]
-    currentProgram $= Just (_shaderProgram $ _wallFaceShader pdata)
-    uniform (head (fromJust $ _shaderCustomUnis $ _wallFaceShader pdata) )
-            $= pmat
-    drawShader (_wallFaceShader pdata) n
-
-setWallDepth :: RenderData -> [(Point2,Point2)] -> (Float,Float) -> GLmatrix GLfloat -> IO Word32
+setWallDepth
+    :: RenderData
+    -> [(Point2,Point2)]    -- ^ Wall points
+    -> (Float,Float)        -- ^ View from point
+    -> GLmatrix GLfloat
+    -> IO Word32
 setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
     startTicks <- SDL.ticks
     colorMask $= Color4 Disabled Disabled Disabled Disabled
@@ -55,6 +50,8 @@ setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
     endTicks <- SDL.ticks
     return $ endTicks - startTicks
 
+halfSize (Size x y) = Size (div x 2) (div y 2)
+
 createLightMap 
     :: RenderData 
     -> Float                -- Rotation
@@ -66,8 +63,13 @@ createLightMap
     -> (Float,Float)        -- View from position
     -> GLmatrix GLfloat 
     -> IO ()
-createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
+createLightMap pdata rot zoom (tranx,trany) (winx',winy') wallPoints lightPoints
                     (viewFromx,viewFromy) pmat = do
+    let winx = winx' / 2
+        winy = winy' / 2
+
+    (vppos,vpsize) <- get viewport
+    viewport $= (vppos, halfSize vpsize)
 
     bindFramebuffer Framebuffer $= _spareFBO pdata
 -- store wall and light positions into buffer
@@ -140,6 +142,7 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     cullFace $= Nothing
     stencilTest $= Disabled
     blend $= Disabled
+    viewport $= (vppos, vpsize)
     bindFramebuffer Framebuffer $= defaultFramebufferObject
     colorMask $= Color4 Disabled Disabled Disabled Enabled
     bindShaderBuffers [_fullscreenShader pdata] [4]
@@ -148,7 +151,13 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
     colorMask $= Color4 Enabled Enabled Enabled Enabled
     blend $= Enabled
 
-renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
+renderBackground 
+    :: RenderData 
+    -> Float            -- Rotation
+    -> Float            -- Zoom
+    -> (Float,Float)    -- Translation
+    -> (Float,Float)    -- Window size
+    -> IO ()
 renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do
 --    depthFunc $= Just Less
 -- set drawing for on top
@@ -164,7 +173,13 @@ renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do
     textureBinding Texture2D $= _textureObject <$> _shaderTexture (_backgroundShader pdata)
     drawArrays Points 0 1
 
-setCommonUniforms :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
+setCommonUniforms
+    :: RenderData
+    -> Float            -- ^ Rotation
+    -> Float            -- ^ Zoom
+    -> (Float,Float)    -- ^ Translation
+    -> (Float,Float)    -- ^ Window size
+    -> IO ()
 setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
     setShaderUniforms rot zoom (tranx,trany) (winx,winy) 
         ( extractProgAndUnis (_lightingFloorShader pdata) 
@@ -174,7 +189,11 @@ setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
         : map extractProgAndUnis (_pictureShaders pdata)
         )
 
-renderFoldable :: Foldable f => RenderData -> f RenderType -> IO Word32
+renderFoldable
+    :: Foldable f
+    => RenderData
+    -> f RenderType
+    -> IO Word32
 renderFoldable pdata tree = do
     pokeStartTicks <- SDL.ticks
 
@@ -183,7 +202,7 @@ renderFoldable pdata tree = do
 -- poke data, returns list of number of vertices for each shader
     is <- F.foldM (pokeShaders slist) tree
 
--- the idea of doing as binding of buffers at once, rather than interweaving with draw
+-- the idea of binding many buffers at once, rather than interweaving with draw
 -- calls, is to prevent opengl from waiting for a draw call to finish
 -- before it performs another state change
     bindShaderBuffers slist is
@@ -194,13 +213,20 @@ renderFoldable pdata tree = do
     return $ pokeEndTicks - pokeStartTicks
 ------------------------------end renderFoldable
 
-
-pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
+pokeTwoOff 
+    :: Ptr Float 
+    -> Int 
+    -> (Float,Float) 
+    -> IO ()
 {-# INLINE pokeTwoOff #-}
 pokeTwoOff ptr n (x,y) = do
     pokeElemOff ptr (2*n+0) x
     pokeElemOff ptr (2*n+1) y
-pokeThreeOff :: Ptr Float -> Int -> (Float,Float,Float) -> IO ()
+pokeThreeOff 
+    :: Ptr Float 
+    -> Int 
+    -> (Float,Float,Float) 
+    -> IO ()
 {-# INLINE pokeThreeOff #-}
 pokeThreeOff ptr n (x,y,z) = do
     pokeElemOff ptr (3*n+0) x