Add file, move buffer swapping into doDrawing

src/Dodge/Render.hs

@@ -3,6 +3,8 @@ module Dodge.Render (
     doDrawing,
 ) where
 
+import Picture.Base
+import qualified SDL
 import qualified Data.Vector as V
 import Dodge.Render.Shadow
 import Control.Lens
@@ -29,8 +31,8 @@ import Shader.ExtraPrimitive
 import Shader.Parameters
 import Shader.Poke
 
-doDrawing :: RenderData -> Universe -> IO ()
-doDrawing pdata u = do
+doDrawing :: SDL.Window -> RenderData -> Universe -> IO ()
+doDrawing win pdata u = do
 --    sTicks <- SDL.ticks
     let w = _uvWorld u
         cfig = _uvConfig u
@@ -74,30 +76,6 @@ doDrawing pdata u = do
                 (0, 0, 0)
                 ws
             )
-    --            ( pokeSPics
-    --                shadV
-    --                layerCounts
-    --                (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
-    --                (_eboPtr $ _shapeEBO pdata)
-    --                (_eboPtr $ _silhouetteEBO pdata)
-    --                (S.cons wallSPics $ worldSPic cfig w)
-    --            )
-    --        <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts))
-    --            ( pokeBindFoldableLayer shadV layerCounts wp)
-    --            ( pokeWallsWindowsFloor
-    --                (shadVBOptr $ _wallTextureShader pdata)
-    --                (shadVBOptr $ _windowShader pdata)
-    --                (shadVBOptr $ _textureArrayShader pdata)
-    --                wallPointsCol
-    --                windowPoints
-    --                (_floorTiles w)
-    --            )
-    --            ( pokeShape
-    --                (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
-    --                (_eboPtr $ _shapeEBO pdata)
-    --                (_eboPtr $ _silhouetteEBO pdata)
-    --                ws
-    --            )
     -- bind wall points, silhouette data, surface geometry
     bindShaderLayers shadV layerCounts
     uncurry bindShaderBuffers $
@@ -293,9 +271,29 @@ doDrawing pdata u = do
     renderLayer FixedCoordLayer shadV layerCounts
     renderFoldable shadV $ fixedCoordPictures u
     depthMask $= Enabled
+    when (debugOn Show_ms_frame $ _uvConfig u) $
+            renderFoldable
+                (_pictureShaders pdata)
+                ( setDepth (-1)
+                    . translate (-0.5) (-0.8)
+                    . scale 0.0005 0.0005
+                    $ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
+                )
+    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
+    col
+        | x < 22 = blue
+        | x < 30 = green
+        | x < 40 = yellow
+        | x < 50 = orange
+        | otherwise = red
+
+
 --------------------------------------------------------------------------------
 -- note: currently assume there is only one UBO, we only bind it once at setup
 bufferUBO :: [Float] -> IO ()