From 192e2c9c579832472bac2292a6328824111bdf61 Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 29 Jul 2021 18:46:01 +0200 Subject: [PATCH] Implement custom poking for vertices--speed regression? --- src/Dodge/Render.hs | 38 +++---- src/Dodge/Render/Picture.hs | 11 -- src/Preload/Render.hs | 6 +- src/Render.hs | 42 +++----- src/Shader.hs | 13 ++- src/Shader/Compile.hs | 4 +- src/Shader/Data.hs | 2 +- src/Shader/Poke.hs | 207 ++++++++++++++++++++++++------------ 8 files changed, 184 insertions(+), 139 deletions(-) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 06f21f767..bfa9b24a4 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -18,8 +18,8 @@ import Render import Data.Preload.Render import Picture.Data import Shader -import Shader.Data import Shader.Poke +import Shader.Data import MatrixHelper --import Polyhedra.Data import Polyhedra @@ -29,7 +29,7 @@ import Foreign --import Control.Monad.State import Control.Lens import Control.Monad -import qualified Control.Foldl as F +--import qualified Control.Foldl as F --import Data.Tuple.Extra --import Data.List --import Data.Bifunctor @@ -53,26 +53,20 @@ doDrawing pdata w = do pic = worldPictures w -- bind as much data into vbos as feasible at this point -- poke wall points and colors - -- _ <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol) --pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) $ wallsToList wallPointsCol --let nWalls = length wallPointsCol - nWalls <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) wallPointsCol + nWalls <- pokeWalls (shadVBOptr $ _wallTextureShader pdata) wallPointsCol --poke -- poke silhouette vertex data - -- nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) - -- (concatMap polyToRender (foregroundPics w)) - nSils <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingLineShadowShader pdata) + nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) (_foregroundEdgeVerx w) -- poke foreground geometry and floor let addC (xx,yy) = (xx,yy,0) - nsurfVs <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingSurfaceShader pdata) - $ (polyToTris $ map addC $ screenPolygon w) + nsurfVs <- pokePoint3s (shadVBOptr $ _lightingSurfaceShader pdata) + $ polyToTris (map addC $ screenPolygon w) ++ concatMap polyToGeoRender' (foregroundPics w) - --nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) - -- $ Render3 (polyToTris $ map addC $ screenPolygon w) - -- : concatMap polyToGeoRender (foregroundPics w) -- bind wall points, silhouette data, surface geometry uncurry bindShaderBuffers $ unzip @@ -92,24 +86,23 @@ doDrawing pdata w = do _ <- renderFoldable pdata $ polysToPic $ foregroundPics w - vnums <- pokeBindFoldableLayer pdata $ pic + vnums <- pokeBindFoldableLayer pdata pic let shads = _pictureShaders pdata - --mapM_ (uncurry $ drawShaderLay 0) ((,) <$> shads <*> count) renderLayer 0 shads vnums - _ <- renderShader (_textureArrayShader pdata) (_floorTiles w) + nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (map _unRender3x3 $ _floorTiles w) + bindShaderBuffers [_textureArrayShader pdata] [nTextArrayVs] + drawShader (_textureArrayShader pdata) nTextArrayVs bindFramebuffer Framebuffer $= fst (_fboBloom pdata) clear [ColorBuffer] blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - --mapM_ (uncurry $ drawShaderLay 1) (vnums IM.! 1) + renderLayer 1 shads vnums bindFramebuffer Framebuffer $= fst (_fboColor pdata) clear [ColorBuffer] depthMask $= Disabled - --mapM_ (uncurry $ drawShaderLay 3) (vnums IM.! 3) - --mapM_ (uncurry $ drawShaderLay 4) (vnums IM.! 4) - --mapM_ (uncurry $ drawShaderLay 5) (vnums IM.! 5) + renderLayer 3 shads vnums renderLayer 4 shads vnums renderLayer 5 shads vnums @@ -171,9 +164,7 @@ doDrawing pdata w = do rds -> do let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO () bindDrawDist ((a,b),(c,d),(e,f),g) = do - --bindDrawDist distParam = do - --_ <- F.foldM (pokeShader $ _barrelShader pdata) [Render2221 distParam] - pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _barrelShader pdata) + pokeArray (shadVBOptr $ _barrelShader pdata) [a,b,c,d,e,f,g] bindShaderBuffers [_barrelShader pdata] [1] drawShader (_barrelShader pdata) 1 @@ -223,8 +214,7 @@ renderWindows -> [((Point2,Point2),Point4)] -- ^ List: wall positions and color -> IO () renderWindows pdata wps = do - --n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps) - n <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallBlankShader pdata) wps + n <- pokeWalls (shadVBOptr $ _wallBlankShader pdata) wps bindShaderBuffers [_wallBlankShader pdata] [n] currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata) cullFace $= Just Back diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 064284bab..d4d0639e5 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -214,17 +214,6 @@ wallsAndWindows w wallsToList :: [((Point2,Point2),Point4)] -> [Float] wallsToList = concatMap (\(((a,b),(c,d)),(e,f,g,h)) -> [a,b,c,d,e,f,g,h]) -pokePoint3s :: Ptr Float -> [Point3] -> IO Int -pokePoint3s ptr vals0 = go vals0 0 - where - go [] n = return n - go ( (a,b,c):vals) n = do - pokeElemOff ptr (off 0) a - pokeElemOff ptr (off 1) b - pokeElemOff ptr (off 2) c - go vals (n+1) - where - off i = n*3 + i pokeWalls :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int pokeWalls ptr vals0 = go vals0 0 diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 5490d373c..19f58d921 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -38,7 +38,7 @@ preloadRender = do , nullPtr , DynamicDraw ) - let wpVBO = VBO {_vbo = wpVBOname, _vboPointer = wpVBOptr, _vboAttribSizes = [4,4], _vboStride = 8} + let wpVBO = VBO {_vbo = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4,4], _vboStride = 8} wpVAOname <- genObjectName bindVertexArrayObject $= Just wpVAOname bindBuffer ArrayBuffer $= Just wpVBOname @@ -74,11 +74,11 @@ preloadRender = do -- fullscreen shaders fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip $ const cornerListNoCoord - pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fullscreenAlphaHalveShad) $ concat cornerListNoCoord + pokeArray (shadVBOptr fullscreenAlphaHalveShad) $ concat cornerListNoCoord -- texture shaders, no textures attached fsShad <- makeShaderSized "texture/simple" [vert,frag] [2,2] 4 ETriangleStrip $ const cornerList -- note we directly poke the shader vertex data here - pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList + pokeArray (shadVBOptr fsShad) $ concat cornerList bloomBlurShad <- makeShaderUsingShaderVAO "texture/bloomBlur" [vert,frag] ETriangleStrip fsShad colorBlurShad <- makeShaderUsingShaderVAO "texture/colorBlur" [vert,frag] ETriangleStrip fsShad grayscaleShad <- makeShaderUsingShaderVAO "texture/grayscale" [vert,frag] ETriangleStrip fsShad diff --git a/src/Render.hs b/src/Render.hs index 55998b987..bbef676b9 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -15,7 +15,7 @@ import Geometry.Data --import Control.Lens import Control.Monad -import qualified Control.Foldl as F +--import qualified Control.Foldl as F import Foreign hiding (rotate) import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T) --import Data.Foldable @@ -140,28 +140,16 @@ drawTextureOnFramebuffer fs fbo to = do textureBinding Texture2D $= Just to drawShader fs 4 -renderShader - :: Foldable f - => FullShader - -> f RenderType - -> IO Word32 -renderShader shad dat = do - sticks <- SDL.ticks - i <- F.foldM (pokeShader shad) dat - bindShaderBuffers [shad] [i] - drawShader shad i - eticks <- SDL.ticks - return $ eticks - sticks - pokeBindFoldable - :: Foldable f - => RenderData - -> f Verx + -- :: Foldable f + :: RenderData + -> [Verx] -> IO (PicShads Int) pokeBindFoldable pdata m = do let shads = _pictureShaders pdata - counts = zeroCounts - elist <- foldM (pokeVX' shads) counts m + --counts = zeroCounts + --elist <- foldM (pokeVX' shads) counts m + elist <- pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m bindShader shads elist return elist @@ -169,23 +157,23 @@ zeroCounts :: PicShads Int zeroCounts = PicShads 0 0 0 0 0 0 pokeBindFoldableLayer - :: Foldable f - => RenderData - -> f Verx +-- :: Foldable f + :: RenderData + -> [Verx] -> IO (IM.IntMap (PicShads Int)) pokeBindFoldableLayer pdata m = do let shads = _pictureShaders pdata - slist' = (IM.fromList ((,) <$> [0..6] <*> [zeroCounts])) :: IM.IntMap (PicShads Int) + --slist' = (IM.fromList ((,) <$> [0..6] <*> [zeroCounts])) :: IM.IntMap (PicShads Int) - slist'' <- foldM (pokeVX shads) slist' m + --slist'' <- foldM (pokeVX shads) slist' m + slist'' <- pokeLayVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m bindShaderLay shads slist'' return slist'' renderFoldable - :: Foldable f - => RenderData - -> f Verx + :: RenderData + -> [Verx] -> IO Word32 renderFoldable pdata struct = do pokeStartTicks <- SDL.ticks diff --git a/src/Shader.hs b/src/Shader.hs index 21ebc9152..1bb7a04a2 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -7,6 +7,7 @@ module Shader , drawShader , freeShaderPointers , drawShaderLay + , shadVBOptr ) where --import Geometry.Data import Shader.Data @@ -32,7 +33,7 @@ bindArrayBuffers numVs theVBO = do WriteToBuffer 0 (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) - (_vboPointer theVBO) + (_vboPtr theVBO) bindArrayBuffersLayer' :: Int -> Int -> VBO -> IO () bindArrayBuffersLayer' lay numVs theVBO = do @@ -42,7 +43,7 @@ bindArrayBuffersLayer' lay numVs theVBO = do WriteToBuffer (fromIntegral $ floatSize * stride * numSubElements * lay) (fromIntegral $ floatSize * numVs * stride) - (_vboPointer theVBO `plusPtr` (floatSize * stride * numSubElements * lay)) + (_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay)) where stride = sum $ _vboAttribSizes theVBO @@ -54,7 +55,7 @@ bindArrayBuffersLayer numVs lay theVBO = do WriteToBuffer (fromIntegral $ floatSize * stride * numSubElements * lay) (fromIntegral $ floatSize * numVs * stride) - (_vboPointer theVBO `plusPtr` (floatSize * stride * numSubElements * lay)) + (_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay)) where stride = sum $ _vboAttribSizes theVBO @@ -100,4 +101,8 @@ drawShader fs i = do glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) 0 (fromIntegral i) freeShaderPointers :: FullShader -> IO () -freeShaderPointers fs = free $ _vboPointer $ _vaoVBO $ _shaderVAO fs +freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shaderVAO fs + +shadVBOptr :: FullShader -> Ptr Float +shadVBOptr = _vboPtr . _vaoVBO . _shaderVAO + diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 2301e0602..fecfae4af 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -149,7 +149,7 @@ setupVBO sizes = do ) return $ VBO { _vbo = vboName - , _vboPointer = thePtr + , _vboPtr = thePtr , _vboAttribSizes = sizes , _vboStride = sum sizes } @@ -172,7 +172,7 @@ setupVBOSized sizes ndraw = do ) return $ VBO { _vbo = vboName - , _vboPointer = thePtr + , _vboPtr = thePtr , _vboAttribSizes = sizes , _vboStride = sum sizes } diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index b6f93732d..4c970ca77 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -56,7 +56,7 @@ and a list of attribute pointer sizes. Vertex attributes are interleaved within the vbo. -} data VBO = VBO { _vbo :: BufferObject - , _vboPointer :: Ptr Float + , _vboPtr :: Ptr Float , _vboAttribSizes :: [Int] -- ^ It is not clear to me if this is necessary to store or not , _vboStride :: Int } diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 8f94187da..e5440b5a6 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -1,40 +1,26 @@ ---{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TupleSections #-} module Shader.Poke ( pokeArrayOff - , pokeShader - , pokeShaderLayer , pokeVX , pokeVX' + , pokePoint3s + , pokePoint33s + , pokeVerxs + , pokeLayVerxs ) where import Shader.Data import Shader.Parameters import Picture.Data +import Geometry.Data --import Data.Maybe --import Data.List import Foreign -import Control.Monad -import qualified Control.Foldl as F +--import Control.Monad +--import qualified Control.Foldl as F import qualified Data.IntMap.Strict as IM import Control.Lens -pokeShader :: FullShader -> F.FoldM IO RenderType Int -pokeShader fs = F.FoldM (pokeVertices fls ptr stride) (return 0) return - where - theVBO = _vaoVBO $ _shaderVAO fs - ptr = _vboPointer theVBO - stride = _vboStride theVBO - fls = _shaderPokeStrategy fs - -pokeVertices - :: (RenderType -> [[Float]]) - -> Ptr Float - -> Int -- ^ stride - -> Int -- ^ number of vertices already poked - -> RenderType - -> IO Int -pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt) - getterPicShad :: VertexType -> PicShads a -> a --{-# INLINE getterPicShad #-} getterPicShad PolyV = _psPoly @@ -59,11 +45,72 @@ pokeVX' shads count vx = do vshad = g shads n = g count theVBO = _vaoVBO $ _vshaderVAO vshad - ptr = _vboPointer theVBO + ptr = _vboPtr theVBO stride = _vboStride theVBO pokeArrayOff ptr (stride * n) (toFls' vx) return $ count & f +~ 1 +pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int) +pokeVerxs vbos vxs0 = go vxs0 (pure 0) + where + go [] count = return count + go (vx:vxs) count = pokeVerx vbos count vx >> go vxs (addCountVerx count vx) + +-- this is very brittle, but want to optimise speed if possible here +pokeVerx :: PicShads VBO -> PicShads Int -> Verx -> IO () +pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case theType of + PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) (_psPoly offsets * 7 * floatSize)) thePos theCol + PolyzV x -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + where + thePtr = plusPtr (_vboPtr $ _psPolyz vbos) (_psPolyz offsets * 8 * floatSize) + BezV (x,y,z,w) -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + >> pokeElemOff thePtr 8 y + >> pokeElemOff thePtr 9 z + >> pokeElemOff thePtr 10 w + where + thePtr = plusPtr (_vboPtr $ _psBez vbos) (_psBez offsets * 11 * floatSize) + TextV (x,y) -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + >> pokeElemOff thePtr 8 y + where + thePtr = plusPtr (_vboPtr $ _psText vbos) (_psText offsets * 9 * floatSize) + ArcV (x,y,z) -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + >> pokeElemOff thePtr 8 y + >> pokeElemOff thePtr 9 z + where + thePtr = plusPtr (_vboPtr $ _psArc vbos) (_psArc offsets * 10 * floatSize) + EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) (_psEll offsets * 7 * floatSize)) thePos theCol + +poke34 :: Ptr Float -> Point3 -> Point4 -> IO () +poke34 ptr (a,b,c) (d,e,f,g) = do + pokeElemOff ptr 0 a + pokeElemOff ptr 1 b + pokeElemOff ptr 2 c + pokeElemOff ptr 3 d + pokeElemOff ptr 4 e + pokeElemOff ptr 5 f + pokeElemOff ptr 6 g + +addCountVerx :: PicShads Int -> Verx -> PicShads Int +addCountVerx ps@PicShads + { _psPoly = sPoly + , _psPolyz = sPolyz + , _psBez = sBez + , _psText = sText + , _psArc = sArc + , _psEll = sEll + } Verx{_vxType=theType} = case theType of + PolyV -> ps {_psPoly = sPoly + 1} + PolyzV _ -> ps {_psPolyz = sPolyz + 1} + BezV _ -> ps {_psBez = sBez + 1} + TextV _ -> ps {_psText = sText + 1} + ArcV _ -> ps {_psArc = sArc + 1} + EllV -> ps {_psEll = sEll + 1} + + pokeVX :: PicShads VShader -> IM.IntMap (PicShads Int) -> Verx -> IO (IM.IntMap (PicShads Int)) pokeVX shads laycounts vx = do let theType = _vxType vx @@ -73,35 +120,12 @@ pokeVX shads laycounts vx = do vshad = getF shads n = getF counts theVBO = _vaoVBO $ _vshaderVAO vshad - ptr = _vboPointer theVBO + ptr = _vboPtr theVBO stride = _vboStride theVBO pokeArrayOff ptr (stride * (n+offset * numSubElements)) (toFls' vx) return $ laycounts & ix offset . setterPicShad theType +~ 1 -pokeShaderLayer :: (Int,VShader) -> F.FoldM IO Verx Int -pokeShaderLayer (l,fs) = F.FoldM (pokeVerticesOff ptr (_vshaderPokeTest fs) stride l) (return 0) return - where - theVBO = _vaoVBO $ _vshaderVAO fs - ptr = _vboPointer theVBO - stride = _vboStride theVBO - -pokeVerticesOff - :: Ptr Float - -> (VertexType -> Bool) - -> Int -- ^ stride - -> Int -- ^ offset - -> Int -- ^ number of vertices already poked - -> Verx - -> IO Int -pokeVerticesOff ptr vtest stride offset n vx - | offset == i && typetest = do - foldM (pokeVertexOff ptr stride offset) n (toFls vx) - | otherwise = return n - where - i = _vxLayer vx - typetest = vtest (_vxType vx) - toFls' :: Verx -> [Float] toFls' vx = flat3 (_vxPos vx) ++ flat4 (_vxCol vx) ++ f (_vxType vx) where @@ -111,27 +135,76 @@ toFls' vx = flat3 (_vxPos vx) ++ flat4 (_vxCol vx) ++ f (_vxType vx) f (ArcV x) = flat3 x f _ = [] -toFls :: Verx -> [[Float]] -toFls vx = [flat3 (_vxPos vx) ++ flat4 (_vxCol vx) ++ f (_vxType vx)] - where - f (PolyzV x) = [x] - f (BezV x) = flat4 x - f (TextV x) = flat2 x - f (ArcV x) = flat3 x - f _ = [] - -pokeVertexOff :: Ptr Float -> Int -> Int -> Int -> [Float] -> IO Int -pokeVertexOff ptr stride offset n fs = do - pokeArrayOff ptr (stride * (n + offset * numSubElements)) fs - return $ n + 1 - - -pokeVertex :: Ptr Float -> Int -> Int -> [Float] -> IO Int -pokeVertex ptr stride n fs = do - pokeArrayOff ptr (stride * n) fs - return $ n + 1 - pokeArrayOff :: Storable a => Ptr a -> Int -> [a] -> IO () --{-# INLINE pokeArrayOff #-} --pokeArrayOff ptr i = zipWithM_ (pokeElemOff ptr) [i..] pokeArrayOff ptr i = pokeArray (plusPtr ptr (floatSize * i)) + +pokePoint33s :: Ptr Float -> [(Point3,Point3)] -> IO Int +pokePoint33s ptr vals0 = go vals0 0 + where + go [] n = return n + go ( ((a,b,c),(d,e,f)):vals) n = do + pokeElemOff ptr (off 0) a + pokeElemOff ptr (off 1) b + pokeElemOff ptr (off 2) c + pokeElemOff ptr (off 3) d + pokeElemOff ptr (off 4) e + pokeElemOff ptr (off 5) f + go vals (n+1) + where + off i = n*6 + i + +pokePoint3s :: Ptr Float -> [Point3] -> IO Int +pokePoint3s ptr vals0 = go vals0 0 + where + go [] n = return n + go ( (a,b,c):vals) n = do + pokeElemOff ptr (off 0) a + pokeElemOff ptr (off 1) b + pokeElemOff ptr (off 2) c + go vals (n+1) + where + off i = n*3 + i + +pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int)) +pokeLayVerxs vbos vxs0 = go vxs0 (IM.fromList $ (, pure 0) <$> [0..5]) + where + go [] count = return count + go (vx:vxs) count = pokeLayVerx vbos count vx >> go vxs (addLayCountVerx count vx) + +-- this is very brittle, but want to optimise speed if possible here +pokeLayVerx :: PicShads VBO -> IM.IntMap (PicShads Int) -> Verx -> IO () +pokeLayVerx vbos imoffsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType, _vxLayer = theLay} = case theType of + PolyV -> poke34 (plusPtr (_vboPtr $ _psPoly vbos) ((_psPoly offsets + layOff) * 7 * floatSize)) thePos theCol + PolyzV x -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + where + thePtr = plusPtr (_vboPtr $ _psPolyz vbos) ((_psPolyz offsets + layOff) * 8 * floatSize) + BezV (x,y,z,w) -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + >> pokeElemOff thePtr 8 y + >> pokeElemOff thePtr 9 z + >> pokeElemOff thePtr 10 w + where + thePtr = plusPtr (_vboPtr $ _psBez vbos) ((_psBez offsets + layOff) * 11 * floatSize) + TextV (x,y) -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + >> pokeElemOff thePtr 8 y + where + thePtr = plusPtr (_vboPtr $ _psText vbos) ((_psText offsets + layOff) * 9 * floatSize) + ArcV (x,y,z) -> poke34 thePtr thePos theCol + >> pokeElemOff thePtr 7 x + >> pokeElemOff thePtr 8 y + >> pokeElemOff thePtr 9 z + where + thePtr = plusPtr (_vboPtr $ _psArc vbos) ((_psArc offsets + layOff) * 10 * floatSize) + EllV -> poke34 (plusPtr (_vboPtr $ _psEll vbos) ((_psEll offsets + layOff) * 7 * floatSize)) thePos theCol + where + layOff = theLay * numSubElements + offsets = imoffsets IM.! theLay + +addLayCountVerx :: IM.IntMap (PicShads Int) -> Verx -> IM.IntMap (PicShads Int) +addLayCountVerx m vx = IM.adjust f (_vxLayer vx) m + where + f = flip addCountVerx vx