diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index be32a549f..8a937da2f 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -25,29 +25,13 @@ data PreloadData = PreloadData , _arcShader :: Program , _fadeCircleShader :: Program , _triVAO :: VAO - , _textVAO' :: VAO - , _circVAO' :: VAO - , _arcVAO' :: VAO - , _basicVAO :: VertexArrayObject - , _textVAO :: VertexArrayObject - , _circVAO :: VertexArrayObject - , _arcVAO :: VertexArrayObject + , _lineVAO :: VAO + , _textVAO :: VAO + , _circVAO :: VAO + , _arcVAO :: VAO , _posVBO :: BufferObject , _colVBO :: BufferObject , _texVBO :: BufferObject - , _ptrPosVBO :: Ptr Float - , _ptrColVBO :: Ptr Float - , _ptrCharPos :: Ptr Float - , _ptrCharCol :: Ptr Float - , _ptrCharTex :: Ptr Float - , _ptrCircPos :: Ptr Float - , _ptrCircCol :: Ptr Float - , _ptrCircSca :: Ptr Float - , _ptrArcPos :: Ptr Float - , _ptrArcCol :: Ptr Float - , _ptrArcSca :: Ptr Float - , _ptrLinePos :: Ptr Float - , _ptrLineCol :: Ptr Float , _uniWinSize :: UniformLocation , _csZoomUni :: UniformLocation , _asWinUni :: UniformLocation @@ -159,34 +143,10 @@ doPreload' = do textureFilter Texture2D $= ((Linear',Just Linear') , Nearest) trivao <- setupVAO' [(posVBO,0,3),(colVBO,1,4)] + linevao <- setupVAO' [(posVBO,0,3),(colVBO,1,4)] textvao <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)] circvao <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)] arcvao <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)] --- setup VAOs: basic vao - basicVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4)] - textVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)] - circVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)] - arcVAO <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)] - --- allocate memory for vertex attributes --- for triangles - ptrPosVBO <- mallocArray (3*3*20000) - ptrColVBO <- mallocArray (3*4*20000) --- for characters - ptrCharPos <- mallocArray (3*20000) - ptrCharCol <- mallocArray (4*20000) - ptrCharTex <- mallocArray (2*20000) --- for circles - ptrCircPos <- mallocArray (3*20000) - ptrCircCol <- mallocArray (4*20000) - ptrCircSca <- mallocArray (2*20000) --- for lines - ptrLinePos <- mallocArray (3*20000) - ptrLineCol <- mallocArray (4*20000) --- for arcs - ptrArcPos <- mallocArray (3*20000) - ptrArcCol <- mallocArray (4*20000) - ptrArcSca <- mallocArray (4*20000) return $ PreloadData { _charMap = convertRGBA8 cmap @@ -196,45 +156,26 @@ doPreload' = do , _arcShader = as , _fadeCircleShader = fcs , _triVAO = trivao - , _textVAO' = textvao - , _circVAO' = circvao - , _arcVAO' = arcvao - , _basicVAO = basicVAO - , _textVAO = textVAO - , _circVAO = circVAO - , _arcVAO = arcVAO + , _textVAO = textvao + , _circVAO = circvao + , _arcVAO = arcvao + , _lineVAO = linevao , _posVBO = posVBO , _colVBO = colVBO , _texVBO = texVBO - , _ptrPosVBO = ptrPosVBO - , _ptrColVBO = ptrColVBO - , _ptrCharPos = ptrCharPos - , _ptrCharCol = ptrCharCol - , _ptrCharTex = ptrCharTex - , _ptrCircPos = ptrCircPos - , _ptrCircCol = ptrCircCol - , _ptrCircSca = ptrCircSca - , _ptrArcPos = ptrArcPos - , _ptrArcCol = ptrArcCol - , _ptrArcSca = ptrArcSca - , _ptrLinePos = ptrLinePos - , _ptrLineCol = ptrLineCol , _uniWinSize = winSizeUni , _csZoomUni = zoomUni , _asWinUni = asWinSizeUniLoc , _asZoomUni = asZoomUniLoc } +vaoPointers :: VAO -> [Ptr Float] +vaoPointers = (\(_,ps,_) -> ps) . unzip3 . _vaoBufferTargets + cleanUpPreload :: PreloadData -> IO () cleanUpPreload pd = do - free (_ptrPosVBO pd) - free (_ptrColVBO pd) - free (_ptrCharPos pd) - free (_ptrCharCol pd) - free (_ptrCharTex pd) - free (_ptrCircPos pd) - free (_ptrCircCol pd) - free (_ptrCircSca pd) - free (_ptrArcPos pd) - free (_ptrArcCol pd) - free (_ptrArcSca pd) + mapM_ free $ vaoPointers $ _triVAO pd + mapM_ free $ vaoPointers $ _textVAO pd + mapM_ free $ vaoPointers $ _circVAO pd + mapM_ free $ vaoPointers $ _arcVAO pd + mapM_ free $ vaoPointers $ _lineVAO pd diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index b555d1f9e..b1987ce2f 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -254,10 +254,10 @@ renderPicture' pdata zoom (winx,winy) pic = do (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) -- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata) <- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata) - (threePtrsVAO $ _textVAO' pdata) - (threePtrsVAO $ _circVAO' pdata) - (_ptrLinePos pdata, _ptrLineCol pdata) - (threePtrsVAO $ _arcVAO' pdata) + (threePtrsVAO $ _textVAO pdata) + (threePtrsVAO $ _circVAO pdata) + (twoPtrsVAO $ _lineVAO pdata) + (threePtrsVAO $ _arcVAO pdata) ) $ picToFTree pic depthFunc $= Just Less @@ -268,29 +268,27 @@ renderPicture' pdata zoom (winx,winy) pic = do drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ nTriVs) -- draw lines, don't need to change the program or vaos, just need to bind the -- vbos and draw - bindArrayBuffers nLineVs - [(_posVBO pdata, _ptrLinePos pdata, 3) - ,(_colVBO pdata, _ptrLineCol pdata, 4) - ] + bindVertexArrayObject $= Just (_vao $ _lineVAO pdata) + bindArrayBuffers nTriVs $ _vaoBufferTargets $ _lineVAO pdata drawArrays Lines (fromIntegral firstIndex) (fromIntegral $ nLineVs) -- draw circles currentProgram $= Just (_circShader pdata) uniform (_uniWinSize pdata) $= Vector2 winx winy uniform (_csZoomUni pdata) $= zoom - bindVertexArrayObject $= Just (_vao $ _circVAO' pdata) - bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO' pdata + bindVertexArrayObject $= Just (_vao $ _circVAO pdata) + bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numCircVs) -- draw arcs currentProgram $= Just (_arcShader pdata) uniform (_asWinUni pdata) $= Vector2 winx winy uniform (_asZoomUni pdata) $= zoom - bindVertexArrayObject $= Just (_vao $ _arcVAO' pdata) - bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO' pdata + bindVertexArrayObject $= Just (_vao $ _arcVAO pdata) + bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs) -- draw text currentProgram $= Just (_textShader pdata) - bindVertexArrayObject $= Just (_vao $ _textVAO' pdata) - bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO' pdata + bindVertexArrayObject $= Just (_vao $ _textVAO pdata) + bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs) bufferOffset :: Integral a => a -> Ptr b