Use texture array for character rendering, condense rendering

2023-03-23 14:08:07 +00:00
parent 68b43f29ff
commit 3350a8dc30
9 changed files with 80 additions and 42 deletions
@@ -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
@@ -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)
@@ -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
@@ -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]
@@ -202,7 +202,7 @@ text :: String -> Picture
 {-# INLINE text #-}
 text = map f . stringToList
  where
-    f (pos, col, V2 a b) = Verx pos col [a, b] BottomLayer textNum
+    f (pos, col, V3 a b c) = Verx pos col [a, b, c, 1] BottomLayer textNum

 line :: [Point2] -> Picture
 {-# INLINE line #-}
@@ -291,25 +291,26 @@ overCol :: (Point4 -> Point4) -> Verx -> Verx
 overCol f vx = vx{_vxCol = f (_vxCol vx)}

 -- no premature optimisation, consider changing to use texture arrays
-stringToList :: String -> [(Point3, Point4, Point2)]
+stringToList :: String -> [(Point3, Point4, Point3)]
 {-# INLINE stringToList #-}
 stringToList = concatMap (uncurry charToTuple) . zip [0, 0.9 * dimText ..]
  where
    dimText = 100

-charToTuple :: Float -> Char -> [(Point3, Point4, Point2)]
+charToTuple :: Float -> Char -> [(Point3, Point4, Point3)]
 {-# INLINE charToTuple #-}
-charToTuple x c =
-    [ (V3 (x -50) (-100) 0, white, V2 offset 1)
-    , (V3 (x -50) 100 0, white, V2 offset 0)
-    , (V3 (x + 50) 100 0, white, V2 (offset + 1) 0)
-    , (V3 (x -50) (-100) 0, white, V2 offset 1)
-    , (V3 (x + 50) (-100) 0, white, V2 (offset + 1) 1)
-    , (V3 (x + 50) 100 0, white, V2 (offset + 1) 0)
-    ]
+charToTuple xoff c = [f 0 0, f 1 0, f 1 1, f 0 0, f 1 1, f 0 1]
  where
+    f x y = (V3 (xoff - 50 + x * 100) (100 - y * 200) 0, white, V3 x y offset)
    offset = fromIntegral (fromEnum c) - 32

+--charToTuple' :: Float -> Char -> [(Point3, Point4, Point3)]
+--{-# INLINE charToTuple' #-}
+--charToTuple' xoff c = [f 0 0, f 1 0, f 1 1, f 0 0, f 1 1, f 0 1]
+--  where
+--    f x y = (V3 (xoff + x * 100) (y * 200) 0, white, V3 x y offset)
+--    offset = fromIntegral (fromEnum c) - 32
+
 mirrorxz :: Picture -> Picture
 mirrorxz = picMap (overPos flipy)
  where
@@ -36,7 +36,6 @@ numLayers = length [minBound :: Layer .. maxBound]

 data ShadNum
    = PolyShad
-    | BezShad
    | TextShad
    | ArcShad
    | EllShad
@@ -129,8 +129,9 @@ preloadRender = do
    aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] pmTriangles
    eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles
    cslist <-
-        makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] pmTriangles
-            >>= _1 (vaddTextureNoFilter "data/texture/charMap.png")
+        makeShader "picture/textureArray" [vert, frag] [3, 4, 4] pmTriangles
+--            >>= _1 (addTextureArray' "data/texture/charMapVert.png" 2 16 32 95 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR)
+            >>= _1 (addTextureArray' "data/texture/charMapVert.png" 2 16 32 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR)
    -- this should really be a 2d texture array

    screentexturevbo <- mglCreate glCreateBuffers
@@ -2,6 +2,7 @@ module Shader.AuxAddition
    ( addSamplerTexture2D
    , vaddTextureNoFilter
    , addTextureArray
+    , addTextureArray'
    , initTexture2D
    , initTexture2DArray
    , tilesToLine
@@ -127,6 +128,20 @@ addTextureArray texturePath (shad,vbo) = do
        return (shad & shaderTextures .:~ TO texname 
            , vbo)

+addTextureArray' :: String -> GLsizei -> GLsizei -> GLsizei -> GLsizei -> GLenum -> GLenum 
+    -> Shader -> IO Shader
+addTextureArray' fp nlev w h d minfilt magfilt shad = do
+    Right cmap <- readImage fp
+    let texdata = convertRGBA8 cmap
+    texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
+    glTextureStorage3D texname nlev GL_RGBA8 w h d
+    VS.unsafeWith (imageData texdata) $ \ptr -> do
+        glTextureSubImage3D texname 0 0 0 0 w h d GL_RGBA GL_UNSIGNED_BYTE ptr
+        glGenerateTextureMipmap texname
+        glTextureParameteri texname GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
+        glTextureParameteri texname GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
+        return (shad & shaderTextures .:~ TO texname )
+
 tilesToLine 
    :: Int -- ^ Parameter a
    -> Int -- ^ Parameter b
@@ -34,15 +34,15 @@ pokeVerxs ::
 pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList

 pokeVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
-pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = theShadNum} = do
+pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = shadnum} = do
    typeOff <- UMV.unsafeRead offsets sn
    basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn
-    let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize)
+    let thePtr = plusPtr basePtr (typeOff * pokeStride shadnum * floatSize)
    poke34 thePtr thePos theCol
    pokeArrayOff thePtr 7 ext
    UMV.unsafeModify offsets (+ 1) sn
  where
-    sn = _unShadNum theShadNum
+    sn = _unShadNum shadnum

 pokeWallsWindows ::
    Ptr Float ->
@@ -416,21 +416,21 @@ pokeLayVerx vbos counts vx = do
    pokeArrayOff thePtr 7 (_vxExt vx)
    UMV.unsafeModify counts (+ 1) vecPos
  where
-    sn = _unShadNum (_vxShadNum vx)
+    sn = _unShadNum shadnum
+    shadnum = _vxShadNum vx
    vecPos = theLayer * numLayers + sn
    theLayer = layerNum $ _vxLayer vx
    thePos = _vxPos vx
    theCol = _vxCol vx
    layOff = theLayer * numSubElements
-    theStride = pokeStride sn
+    theStride = pokeStride shadnum

-pokeStride :: Int -> Int
+pokeStride :: ShadNum -> Int
 {-# INLINE pokeStride #-}
-pokeStride 0 = 7
-pokeStride 1 = 9
-pokeStride 2 = 10
-pokeStride 3 = 7
-pokeStride _ = undefined
+pokeStride PolyShad = 7
+pokeStride TextShad = 11
+pokeStride ArcShad = 10
+pokeStride EllShad = 7

 poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
 {-# INLINE poke34 #-}