Implement low res shadows

2021-04-28 20:50:53 +02:00
parent 5a8555d5a0
commit 8cb177a21c
11 changed files with 147 additions and 77 deletions
@@ -21,7 +21,8 @@ data RenderData = RenderData
    { _lightingFloorShader :: FullShader (Float,Float,Float,Float)
    , _lightingOccludeShader  :: FullShader (Point2,Point2)
    , _lightingWallShader   :: FullShader (Point2,Point2)
-    , _wallFaceShader    :: FullShader ((Point2,Point2),Point4)
+    , _wallBlankShader    :: FullShader ((Point2,Point2),Point4)
+    , _wallTextureShader    :: FullShader ((Point2,Point2),Point4)
    , _backgroundShader  :: FullShader (Point2,Point2,Point2,Point2)
    , _fullscreenShader  :: FullShader ()
    , _pictureShaders :: [FullShader RenderType]
@@ -68,8 +69,12 @@ preloadRender = do
    bgShad <- makeShader "background" [vert,geom,frag] [(0,4),(1,2)] Points pokeBGStrat
                >>= addTexture "data/texture/smudgedDirt.png"

-- wallShader
-    wlFace <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
+-- blank wallShader
+    wlBlank <- makeShader "wall/blank" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
+--                >>= addTexture "data/texture/grayscaleDirt.png"
+                >>= addUniforms ["perpMat"]
+-- textured wallShader
+    wlTexture <- makeShader "wall/texture" [vert,geom,frag] [(0,4),(1,4)] Points pokeWPColStrat
                >>= addTexture "data/texture/grayscaleDirt.png"
                >>= addUniforms ["perpMat"]

@@ -80,16 +85,17 @@ preloadRender = do
    bindFramebuffer Framebuffer $= defaultFramebufferObject
    
    return $ RenderData
-        { _pictureShaders       = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
-        , _lightingFloorShader    = lsShad
-        , _lightingOccludeShader     = wsShad
-        , _lightingWallShader   = wlLightShad
-        , _wallFaceShader       = wlFace
-        , _backgroundShader     = bgShad
-        , _fullscreenShader     = fsShad
-        , _spareFBO              = fbo
-        , _fboTexture            = fboTO
-        , _fboRenderbufferObject = fboRBO
+        { _pictureShaders           = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
+        , _lightingFloorShader      = lsShad
+        , _lightingOccludeShader    = wsShad
+        , _lightingWallShader       = wlLightShad
+        , _wallBlankShader          = wlBlank
+        , _wallTextureShader        = wlTexture
+        , _backgroundShader         = bgShad
+        , _fullscreenShader         = fsShad
+        , _spareFBO                 = fbo
+        , _fboTexture               = fboTO
+        , _fboRenderbufferObject    = fboRBO
        }

 -- potential drawing setup
@@ -113,6 +119,7 @@ setupFramebuffer = do
    fboTO <- genObjectName
    textureBinding Texture2D $= Just fboTO
    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr)
+    texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 8 6) 0 (PixelData RGBA UnsignedByte nullPtr)
    textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
    generateMipmap' Texture2D
    framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
@@ -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