Render cleanup

src/Dodge/Render.hs

@@ -5,21 +5,20 @@ module Dodge.Render (
 
 --import qualified Data.Vector as V
 
-import Dodge.DownscaleSize
-import Data.List (sortOn)
-import Shader.Poke.Cloud
-import GLHelp
 import Control.Lens
 import Control.Monad
 import qualified Control.Monad.Parallel as MP
+import Data.List (sortOn)
 import qualified Data.Map.Strict as M
 import Data.Preload.Render
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import Dodge.Data.Universe
+import Dodge.DownscaleSize
 import Dodge.Render.Lights
 import Dodge.Render.ShapePicture
 import Dodge.Render.Walls
 import Foreign
+import GLHelp
 import Geometry
 import Graphics.GL.Core45
 import MatrixHelper
@@ -28,8 +27,8 @@ import qualified SDL
 import Shader
 import Shader.Bind
 import Shader.Data
-import Shader.Parameters
 import Shader.Poke
+import Shader.Poke.Cloud
 
 doDrawing :: SDL.Window -> RenderData -> Universe -> IO ()
 doDrawing window rdata u
@@ -51,7 +50,7 @@ doDrawing' win pdata u = do
         trans = w ^. cWorld . camPos . camCenter
         wins@(V2 winx winy) = V2 (_windowX cfig) (_windowY cfig)
         resFact = resFactorNum $ cfig ^. graphics_resolution_factor
-        ( windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
+        (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
         lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
         viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
         shadV = _pictureShaders pdata
@@ -61,7 +60,7 @@ doDrawing' win pdata u = do
     layerCounts <- UMV.replicate (numLayers * 6) 0
     -- attempt to poke in parallel
     let (ws, wp) = wallSPics <> worldSPic cfig u
-    (( nWins,trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
+    ((nWins, trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
         MP.bindM3
             (\_ a b -> return (a, b))
             ( pokeLayVerxs
@@ -70,8 +69,8 @@ doDrawing' win pdata u = do
                 wp
             )
             ( pokeWallsWindows
-                ( pdata ^. vboWindows . vboPtr)
+                (pdata ^. vboWindows . vboPtr)
-                ( pdata ^. wallVBO . vboPtr)
+                (pdata ^. wallVBO . vboPtr)
                 windowPoints
                 wallsToPoke
             )
@@ -82,46 +81,42 @@ doDrawing' win pdata u = do
                 (0, 0, 0)
                 ws
             )
+    (nCloudVs, nCloudIs) <-
+        foldM
+            (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
+            (0, 0)
+            (sortOn (^. clPos . _3) $ w ^. cWorld . lWorld . clouds)
     -- bind wall points, silhouette data, surface geometry
     bufferShaderLayers shadV layerCounts
-    uncurry (zipWithM_ bufferPokedVBO) $
+    mapM_
-        unzip
+        (uncurry bufferPokedVBO)
         [ (pdata ^. vboWindows, nWins)
         , (pdata ^. wallVBO, trueNWalls)
+        , (_vboShapes pdata, nShapeVs)
+        , (pdata ^. cloudVBO, nCloudVs)
+        ]
+    mapM_
+        (uncurry bufferEBO)
+        [ (_cloudEBO pdata, nCloudIs)
+        , (_shapeEBO pdata, nIndices)
+        , (_silhouetteEBO pdata, nSilIndices)
         ]
-    bufferPokedVBO (_vboShapes pdata) nShapeVs
-    (nCloudVs,nCloudIs) <- foldM (pokeCloud (pdata ^. cloudVBO . vboPtr) (pdata ^. cloudEBO . eboPtr))
-        (0,0) (sortOn (^. clPos . _3) $ w ^. cWorld . lWorld . clouds)
-    bufferPokedVBO (pdata ^. cloudVBO) nCloudVs
-    glNamedBufferSubData
-        (_eboName $ _cloudEBO pdata)
-        0
-        (fromIntegral $ glushortSize * nCloudIs)
-        (_eboPtr $ _cloudEBO pdata)
-    glNamedBufferSubData
-        (_eboName $ _shapeEBO pdata)
-        0
-        (fromIntegral $ glushortSize * nIndices)
-        (_eboPtr $ _shapeEBO pdata)
-    glNamedBufferSubData
-        (_eboName $ _silhouetteEBO pdata)
-        0
-        (fromIntegral $ glushortSize * nSilIndices)
-        (_eboPtr $ _silhouetteEBO pdata)
     -- set the coordinate uniform ready for drawing elements using world coordinates
     glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. matUBO)
     withArray (perspectiveMatrixb rot camzoom trans wins viewFroms) $ \ptr ->
         glNamedBufferSubData (pdata ^. matUBO) 0 64 ptr
     setViewportSize (round winx `div` resFact) (round winy `div` resFact)
-    glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
+    glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase ._1 . unFBO)
     glDepthMask GL_TRUE
--- the following clear may not be necessary
+    -- the following clear may not be necessary
-    withArray [0,0,0,1] $ \ptr -> glClearNamedFramebufferfv 
+    withArray [0, 0, 0, 1] $ \ptr ->
+        glClearNamedFramebufferfv
             (pdata ^. fboBase . _1 . unFBO)
             GL_COLOR
             0
             ptr
-    with 1 $ \ptr -> glClearNamedFramebufferfv 
+    with 1 $ \ptr ->
+        glClearNamedFramebufferfv
             (pdata ^. fboBase . _1 . unFBO)
             GL_DEPTH
             0
@@ -129,10 +124,16 @@ doDrawing' win pdata u = do
     glDepthFunc GL_LESS
     -- draw wall occlusions from the camera's point of view
     glUseProgram (pdata ^. lightingWallShadShader . shaderUINT)
-    glProgramUniform3f (pdata ^. lightingWallShadShader . shaderUINT) 
+    glProgramUniform3f
-        0 vfx vfy 20
+        (pdata ^. lightingWallShadShader . shaderUINT)
-    glProgramUniform1f (pdata ^. lightingWallShadShader . shaderUINT) 
+        0
-        1 1000
+        vfx
+        vfy
+        20
+    glProgramUniform1f
+        (pdata ^. lightingWallShadShader . shaderUINT)
+        1
+        1000
     glBindVertexArray $ pdata ^. lightingWallShadShader . shaderVAO . vaoName
     unless (debugOn Remove_LOS cfig) $
         glDrawArrays
@@ -140,7 +141,8 @@ doDrawing' win pdata u = do
             0
             (fromIntegral trueNWalls)
     -- clear normals
-    withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
+    withArray [0, 0, 0, 0] $ \ptr ->
+        glClearNamedFramebufferfv
             (pdata ^. fboBase . _1 . unFBO)
             GL_COLOR
             2
@@ -157,17 +159,17 @@ doDrawing' win pdata u = do
         0
         (fromIntegral trueNWalls)
     --glDisable GL_CULL_FACE
---    if cfig ^. graphics_wall_textured
+    --    if cfig ^. graphics_wall_textured
---        then renderTextureWalls pdata nWalls
+    --        then renderTextureWalls pdata nWalls
---        else renderBlankWalls pdata nWalls
+    --        else renderBlankWalls pdata nWalls
     --draw object pictures onto base buffer
     renderLayer BottomLayer shadV layerCounts
     --draw object shapes onto base buffer
     let fs = _shapeShader pdata
     glUseProgram (_shaderUINT fs)
     glBindVertexArray $ fs ^. shaderVAO . vaoName
---    glEnable GL_CULL_FACE
+    --    glEnable GL_CULL_FACE
---    glCullFace GL_BACK
+    --    glCullFace GL_BACK
     glDrawElements
         (_unPrimitiveMode $ _shaderPrimitive fs)
         (fromIntegral nIndices)
@@ -178,7 +180,7 @@ doDrawing' win pdata u = do
     glUseProgram (pdata ^. floorShader . shaderUINT)
     glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName
     glDrawArrays
-        (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive ) 
+        (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive)
         0
         (fromIntegral nFls)
     glEnable GL_BLEND
@@ -207,7 +209,8 @@ doDrawing' win pdata u = do
             ptr
     --draw bloom onto bloom buffer
     glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBloom . _1 . unFBO)
-    withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
+    withArray [0, 0, 0, 0] $ \ptr ->
+        glClearNamedFramebufferfv
             (pdata ^. fboBloom . _1 . unFBO)
             GL_COLOR
             0
@@ -242,12 +245,13 @@ doDrawing' win pdata u = do
     --glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
     --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
-    withArray [0.5,0.5,0.5,0] $ \ptr -> glClearNamedFramebufferfv
+    withArray [0.5, 0.5, 0.5, 0] $ \ptr ->
+        glClearNamedFramebufferfv
             (pdata ^. fboCloud . _1 . unFBO)
             GL_COLOR
             0
             ptr
---    renderLayer MidLayer shadV layerCounts
+    --    renderLayer MidLayer shadV layerCounts
     glUseProgram (pdata ^. cloudShader . shaderUINT)
     glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
     glDrawElements
@@ -262,12 +266,14 @@ doDrawing' win pdata u = do
         glDepthFunc GL_ALWAYS
         glDisable GL_BLEND
         withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr -> glDrawBuffers 3 ptr
-        withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
+        withArray [0, 0, 0, 0] $ \ptr ->
+            glClearNamedFramebufferfv
                 (pdata ^. fboCloud . _1 . unFBO)
                 GL_COLOR
                 1
                 ptr
-        withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv
+        withArray [0, 0, 0, 0] $ \ptr ->
+            glClearNamedFramebufferfv
                 (pdata ^. fboCloud . _1 . unFBO)
                 GL_COLOR
                 2
@@ -287,7 +293,8 @@ doDrawing' win pdata u = do
             nullPtr
         drawShader (_windowShader pdata) nWins
         glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
-        withArray [0,0,0,0] $ \ptr -> glClearNamedFramebufferfv 
+        withArray [0, 0, 0, 0] $ \ptr ->
+            glClearNamedFramebufferfv
                 (pdata ^. fboPos . _1 . unFBO)
                 GL_COLOR
                 0
@@ -378,6 +385,4 @@ setViewportSize :: Int -> Int -> IO ()
 setViewportSize x y =
     glViewport 0 0 (fromIntegral x) (fromIntegral y)
 
-
 --cullFace $= Nothing
-

src/Shader/Bind.hs

@@ -1,8 +1,10 @@
 module Shader.Bind (
     bufferShaderLayers,
     bufferPokedVBO,
+    bufferEBO,
 ) where
 
+import Control.Lens
 import Control.Monad.Primitive
 import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
 import qualified Data.Vector.Mutable as MV
@@ -22,6 +24,14 @@ bufferPokedVBO theVBO numVs =
         (fromIntegral $ floatSize * numVs * _vboVertexSize theVBO)
         (_vboPtr theVBO)
 
+bufferEBO :: EBO -> Int -> IO ()
+bufferEBO ebo numis =
+    glNamedBufferSubData
+        (ebo ^. eboName)
+        0
+        (fromIntegral $ glushortSize * numis)
+        (ebo ^. eboPtr)
+
 bufferShaderLayers :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> IO ()
 bufferShaderLayers shads counts = MV.imapM_ f shads
   where