From 3350a8dc30c384dcaeea10ba7c555dbf483ec864 Mon Sep 17 00:00:00 2001 From: justin Date: Thu, 23 Mar 2023 14:08:07 +0000 Subject: [PATCH] Use texture array for character rendering, condense rendering --- src/Dodge/Render.hs | 19 +++++++++---------- src/Dodge/Render/Picture.hs | 20 ++++++++++++++++++++ src/Dodge/Render/ShapePicture.hs | 15 ++++++++++----- src/Dodge/TestString.hs | 2 -- src/Picture/Base.hs | 23 ++++++++++++----------- src/Picture/Data.hs | 1 - src/Preload/Render.hs | 5 +++-- src/Shader/AuxAddition.hs | 15 +++++++++++++++ src/Shader/Poke.hs | 22 +++++++++++----------- 9 files changed, 80 insertions(+), 42 deletions(-) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 9e0e3edfe..3a863e04d 100644 --- a/src/Dodge/Render.hs +++ b/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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 86132d4ff..ca6c0ca1b 100644 --- a/src/Dodge/Render/Picture.hs +++ b/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) diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 745ef873d..ac1362010 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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 diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 51fa5ad69..d40589e46 100644 --- a/src/Dodge/TestString.hs +++ b/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] diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 1f91fcf4f..42b8ce646 100644 --- a/src/Picture/Base.hs +++ b/src/Picture/Base.hs @@ -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 diff --git a/src/Picture/Data.hs b/src/Picture/Data.hs index 510d11b43..223c2157a 100644 --- a/src/Picture/Data.hs +++ b/src/Picture/Data.hs @@ -36,7 +36,6 @@ numLayers = length [minBound :: Layer .. maxBound] data ShadNum = PolyShad - | BezShad | TextShad | ArcShad | EllShad diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 30627c823..f56a75dfb 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -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 diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 9f7f2ba37..ad4b3bb31 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -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 diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index cf3d1e945..afddf28fa 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -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 #-}