Continue work on shadow rendering

2023-03-14 11:20:38 +00:00
parent 9947979b52
commit 6af041bb8c
20 changed files with 418 additions and 381 deletions
@@ -10,7 +10,7 @@ defaultLS =
        , _lsParam =
            LSParam
                { _lsPos = V3 0 0 50
-                , _lsRad = 700
+                , _lsRad = 450
                , _lsCol = 0.6
                }
        , _lsDir = 0
@@ -2,9 +2,7 @@ module Dodge.LightSource (
    tlsTimeRadFunPos,
    tlsTimeRadColPos,
    lsRadCol,
-    lsPosRadCol,
    lsColPosRad,
-    lsPosColRad,
    lsColPos,
    lsPosCol,
    lsPosRad,
@@ -46,27 +44,22 @@ tlsTimeRadFunPos t rmax intensityF p =
 --            & tlsParam . lsCol .~ f (intensityF (_tlsTime tls) )
 --    f x' = V3 x' x' x'

-lsPosColRad :: Point3 -> Point3 -> Float -> LightSource
-lsPosColRad p col = lsColPosRad col p
-
-lsPosRadCol :: Point3 -> Float -> Point3 -> LightSource
-lsPosRadCol p r col =
-    defaultLS
-        & lsParam . lsPos .~ p
-        & lsParam . lsRad .~ r
-        & lsParam . lsCol .~ col
-
 lsColPosID :: Point3 -> Point3 -> Int -> LightSource
 lsColPosID col p i = lsColPos col p & lsID .~ i

 lsColPos :: Point3 -> Point3 -> LightSource
-lsColPos col pos = lsColPosRad col pos 700
+lsColPos col pos = lsColPosRad col pos 450

 lsPosCol :: Point3 -> Point3 -> LightSource
 lsPosCol pos col = lsColPos col pos

 lsColPosRad :: Point3 -> Point3 -> Float -> LightSource
-lsColPosRad col pos r = lsPosRadCol pos r col
+lsColPosRad col p r = 
+    defaultLS
+        & lsParam . lsPos .~ p
+        & lsParam . lsRad .~ r
+        & lsParam . lsCol .~ col
+

 lsRadCol :: Float -> Point3 -> LightSource
 lsRadCol r col =
@@ -114,14 +114,18 @@ doDrawing' win pdata u = do
    glClear $ sum [GL_COLOR_BUFFER_BIT, GL_DEPTH_BUFFER_BIT]
    glDepthFunc GL_LESS
    -- draw wall occlusions from the camera's point of view
-    glUseProgram (pdata ^. lightingWallShadShader . shadProg')
+--    glEnable GL_CULL_FACE
+--    glCullFace GL_BACK
+    glUseProgram (pdata ^. lightingWallShadShader . shadName)
    glUniform3f (pdata ^?! lightingWallShadShader . shadUnis' . ix 0) vfx vfy 20
+    glUniform1f (pdata ^?! lightingWallShadShader . shadUnis' . ix 1) 100
    glBindVertexArray $ pdata ^. lightingWallShadShader . shadVAO' . vaoName
    unless (debugOn Remove_LOS cfig) $
        glDrawArrays
            (marshalEPrimitiveMode $ pdata ^. lightingWallShadShader . shadPrim')
            0
            (fromIntegral nWalls)
+--    glDisable GL_CULL_FACE
    --draw walls onto base buffer
    if cfig ^. graphics_wall_textured
        then renderTextureWalls pdata nWalls
@@ -130,7 +134,7 @@ doDrawing' win pdata u = do
    renderLayer BottomLayer shadV layerCounts
    --draw object shapes onto base buffer
    let fs = _shapeShader pdata
-    glUseProgram (_shadProg' fs)
+    glUseProgram (_shadName fs)
    glBindVertexArray $ fs ^. shadVAO' . vaoName
    glDrawElements
        (marshalEPrimitiveMode $ _shadPrim' fs)
@@ -140,7 +144,6 @@ doDrawing' win pdata u = do
    --draw floor onto base buffer
    drawShader (_textureArrayShader pdata) nFls
    --draw lightmap into its own buffer
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
    createLightMap
        cfig
        pdata
@@ -159,6 +162,11 @@ doDrawing' win pdata u = do
    glEnable GL_BLEND
    glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
    drawShader (_fullscreenShader pdata) 4
+    with GL_COLOR_ATTACHMENT0 $ \ptr ->
+        glInvalidateNamedFramebufferData 
+            (pdata ^. fboLighting . _1 . unFBO)
+            1
+            ptr
    --draw bloom onto bloom buffer
    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
    glClear GL_COLOR_BUFFER_BIT
@@ -168,21 +176,17 @@ doDrawing' win pdata u = do
    renderLayer BloomNoZWrite shadV layerCounts
    glDepthMask GL_TRUE
    renderLayer BloomLayer shadV layerCounts
-    --glDepthMask GL_TRUE
    --setup downscale viewport for blurring bloom
    setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
-    --bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
    glDepthFunc GL_ALWAYS
-    --textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
-    glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO) -- Just (snd $ _fboBloom pdata)
+    glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO)
    glDisable GL_BLEND
    drawShader (_bloomBlurShader pdata) 4
    replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
    glEnable GL_BLEND
    setViewportSize (round winx `div` resFact) (round winy `div` resFact)
    --draw clouds onto cloud buffer
-    --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthFunc GL_LEQUAL
    glDepthMask GL_FALSE
@@ -191,24 +195,20 @@ doDrawing' win pdata u = do
    --blendColor $= Color4 0.5 0.5 0.5 0.5
    --glBlendFuncSeparate GL_SRC_ALPHASaturate,One) , (One,GL_ONE_MINUS_SRC_ALPHA))
    glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
-    --drawBuffers $= [FBOColorAttachment 0, NoBuffers]
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    glClear GL_COLOR_BUFFER_BIT
    renderLayer MidLayer shadV layerCounts
-    --renderWindows pdata windowPoints
    drawShader (_windowShader pdata) nWins
    when (_graphics_cloud_shadows cfig) $ do
        ----render transparency depths
        glDepthMask GL_TRUE
        glDisable GL_BLEND
        withArray [GL_NONE, GL_COLOR_ATTACHMENT1] $ \ptr -> glDrawBuffers 2 ptr
-        --drawBuffers $= [NoBuffers, FBOColorAttachment 1]
        renderLayer MidLayer shadV layerCounts
        drawShader (_windowShader pdata) nWins
        ----draw lightmap for cloud buffer
        glDepthMask GL_FALSE
        glEnable GL_BLEND
-        --bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
        glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
        createLightMap
            cfig
@@ -224,31 +224,24 @@ doDrawing' win pdata u = do
        glClearColor 0 0 0 0
    --apply lightmap to cloud buffer
    glClearColor 0 0 0 0
-    --bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
    glDepthMask GL_FALSE
-    --drawBuffers $= [FBOColorAttachment 0, NoBuffers]
    withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
    glDepthFunc GL_ALWAYS
-    --textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
    glEnable GL_BLEND
-    --glBlendFunc GL_ZERO, GL_ONE_MINUS_SRC_ALPHA)
    glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    -- bind base buffer for drawing bloom then clouds
-    --bindFramebuffer Framebuffer $= fst (_fboBase pdata)
    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
    --Draw blurred bloom onto base buffer
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE
-    --textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
    drawShader (_fullscreenShader pdata) 4
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
    --draw shadowed clouds onto base buffer
-    --textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata)
    glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata)
    drawShader (_fullscreenShader pdata) 4
    --set viewport for radial distortion
@@ -260,7 +253,6 @@ doDrawing' win pdata u = do
        [] -> do
            bindTO $ fst $ snd $ _fboBase pdata
            glBindFramebuffer GL_FRAMEBUFFER 0
-            --bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
            drawShader (_fullscreenShader pdata) 4
        rds -> do
            let bindDrawDist :: Distortion -> IO ()
@@ -270,14 +262,11 @@ doDrawing' win pdata u = do
                    drawShader (_barrelShader pdata) 1
                fboList =
                    take (length rds - 1) (concat (repeat [fst $ _fbo2 pdata, fst $ _fbo3 pdata]))
-                        -- ++ [defaultFramebufferObject]
                        ++ [FBO 0]
                toList = fst (snd (_fboBase pdata)) : concat (repeat [snd $ _fbo2 pdata, snd $ _fbo3 pdata])
                bindings = zipWith (>>) (map bindFBO fboList) (map bindTO toList)
            glActiveTexture GL_TEXTURE1
-            --activeTexture $= TextureUnit 1
            zipWithM_ (>>) bindings $ map bindDrawDist rds
-            --activeTexture $= TextureUnit 0
            glActiveTexture GL_TEXTURE1
    glDepthFunc GL_ALWAYS
    glEnable GL_BLEND
@@ -288,7 +277,6 @@ doDrawing' win pdata u = do
    glDepthMask GL_FALSE
    glEnable GL_BLEND
    glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-    --bufferUBO (pdata ^. matUBO) $ isoMatrix 0 1 (V2 0 0) (V2 2 2)
    glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. isoMatUBO)
    renderLayer FixedCoordLayer shadV layerCounts
    renderFoldable shadV $ fixedCoordPictures u
@@ -303,9 +291,6 @@ doDrawing' win pdata u = do
            )
    SDL.glSwapWindow win

--    eTicks <- SDL.ticks
--    return (eTicks - sTicks)
-
 fpsText :: (Show a, Ord a, Num a) => a -> Picture
 fpsText x = color col $ text $ "ms/frame " ++ show x
  where
@@ -26,7 +26,7 @@ drawCPUShadows pdata s pos rad = do
        0
        (fromIntegral $ floatSize * i)
        (theshad ^. shadVAO' . vaoVBO . vboPtr)
-    glUseProgram (theshad ^. shadProg')
+    glUseProgram (theshad ^. shadName)
    glBindVertexArray . _vaoName $ _shadVAO' theshad
    glDrawArrays
        (marshalEPrimitiveMode $ _shadPrim' theshad)
@@ -126,7 +126,7 @@ rezColor = do
    col <- takeOne [V3 0.0 0.1 0.5, V3 0.0 0.5 0.1]
    h <- takeOne [30, 50, 80, 90, 90, 90, 90]
    rad <- takeOne [150, 200, 200, 250, 250, 300, 300, 300]
-    return $ lsPosColRad (V3 0 0 h) col rad
+    return $ lsColPosRad col (V3 0 0 h) rad

 rezInvBox :: LightSource -> Room
 rezInvBox = swapInOutLinks . rezBox
@@ -26,7 +26,7 @@ roomCritLS = do
    col <- takeOne [0.5, 0.6]
    h <- takeOne [30, 35]
    rad <- takeOne [300]
-    return $ lsPosColRad (V3 0 0 h) col rad
+    return $ lsColPosRad col (V3 0 0 h) rad

 smallRoom :: Room
 smallRoom = corridorWallN & rmRandPSs .~ [psRandRanges (15, 25) (30, 45) (pi, 2 * pi)]