Use texture array for character rendering, condense rendering

src/Dodge/Render.hs

@@ -62,7 +62,7 @@ doDrawing' win pdata u = do
     -- count mutable vectors setup
     layerCounts <- UMV.replicate (numLayers * 6) 0
     -- attempt to poke in parallel
-    let (ws, wp) = wallSPics <> worldSPic cfig w
+    let (ws, wp) = wallSPics <> worldSPic cfig u
     ((nWalls, nWins,trueNWalls), (nShapeVs, nIndices, nSilIndices)) <-
         MP.bindM3
             (\_ a b -> return (a, b))
@@ -373,16 +373,15 @@ doDrawing' win pdata u = do
     glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
     glBindBufferBase GL_UNIFORM_BUFFER 0 (pdata ^. orthonormalMatUBO)
     renderLayer FixedCoordLayer shadV layerCounts
-    renderFoldable shadV $ fixedCoordPictures u
     glDepthMask GL_TRUE
-    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)
-            )
+--    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
 
 fpsText :: (Show a, Ord a, Num a) => a -> Picture

src/Dodge/Render/Picture.hs

@@ -17,9 +17,29 @@ fixedCoordPictures u = drawMenuOrHUD cfig u
     <> drawConcurrentMessage u 
     <> customMouseCursor cfig (u ^. uvWorld . input)
     <> listPicturesAt (halfWidth cfig) 0 cfig (map text (_uvTestString u u))
+    <> displayFrameTicks u
   where
     cfig = _uvConfig u
 
+displayFrameTicks :: Universe -> Picture
+displayFrameTicks u =   if (debugOn Show_ms_frame $ _uvConfig u) then
+         ( setDepth (-1)
+                . translate (-0.5) (-0.8)
+                . scale 0.0005 0.0005
+                $ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
+            )
+  else mempty
+
+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
+
 drawMenuOrHUD :: Configuration -> Universe -> Picture
 drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
     [] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,8 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
+import Dodge.Render.Picture
+import Dodge.Data.Universe
 import Control.Lens
 import Control.Monad (guard)
 import Data.Foldable
@@ -41,9 +43,9 @@ import ShapePicture
 import ShortShow
 import Sound.Data
 
-worldSPic :: Configuration -> World -> SPic
-worldSPic cfig w =
-    (mempty, extraPics cfig w)
+worldSPic :: Configuration -> Universe -> SPic
+worldSPic cfig u =
+    (mempty, extraPics cfig u)
         <> foldup drawProp' (filtOn _prPos _props)
         <> foldup drawProjectile (filtOn _prjPos _projectiles)
         <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
@@ -56,6 +58,7 @@ worldSPic cfig w =
         <> aimDelaySweep cfig w
         <> anyTargeting cfig w
   where
+    w = _uvWorld u
     foldup = foldMap'
     filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
     pointIsClose = cullPoint cfig w
@@ -144,9 +147,10 @@ cullPoint cfig w p
     | debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . camPos . camBoundBox)
     | otherwise = dist (w ^. cWorld . camPos . camCenter) p < (w ^. cWorld . camPos . camViewDistance)
 
-extraPics :: Configuration -> World -> Picture
-extraPics cfig w =
+extraPics :: Configuration -> Universe -> Picture
+extraPics cfig u =
     pictures (_decorations lw)
+        <> setLayer FixedCoordLayer (fixedCoordPictures u)
         <> concatMapPic drawTractorBeam (_tractorBeams lw)
         <> concatMapPic drawLinearShockwave (_linearShockwaves lw)
         <> concatMapPic drawShockwave (_shockwaves lw)
@@ -167,6 +171,7 @@ extraPics cfig w =
         <> viewClipBounds cfig w
         <> debugDraw cfig w
   where
+    w = u ^. uvWorld
     lw = w ^. cWorld . lWorld
 
 debugDraw :: Configuration -> World -> Picture

src/Dodge/TestString.hs

@@ -14,8 +14,6 @@ import Dodge.Data.Universe
 testStringInit :: Universe -> [String]
 testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . camPos) 
         (u ^. uvWorld . cWorld . lWorld)
-        , show $ length $ fst $ worldSPic (u ^. uvConfig) (u ^. uvWorld)
-        , show $ length $ snd $ worldSPic (u ^. uvConfig) (u ^. uvWorld) 
         , show $ u ^. uvWorld . input . scrollTestInt
         ]
     --[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]