diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 3e8530b3a..be32a549f 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -23,8 +23,11 @@ data PreloadData = PreloadData , _textShader :: Program , _circShader :: Program , _arcShader :: Program - , _lineShader :: Program , _fadeCircleShader :: Program + , _triVAO :: VAO + , _textVAO' :: VAO + , _circVAO' :: VAO + , _arcVAO' :: VAO , _basicVAO :: VertexArrayObject , _textVAO :: VertexArrayObject , _circVAO :: VertexArrayObject @@ -56,6 +59,7 @@ data VAO = VAO } makeLenses ''PreloadData +makeLenses ''VAO floatSize = sizeOf (0.5 :: GLfloat) @@ -75,6 +79,35 @@ setupVAO ps = do vertexAttribArray (AttribLocation aloc) $= Enabled return theVAO +setupVAO' :: [(BufferObject,GLuint,Int)] -> IO VAO +setupVAO' ps = do + theVAO <- genObjectName + bindVertexArrayObject $= Just theVAO + forM_ ps setupArrayBuffer + ptrs <- forM ps setupVBOPointers + return $ VAO theVAO ptrs + +numDrawableElements :: Int +numDrawableElements = 50000 + +setupVBOPointers :: (BufferObject,GLuint,Int) -> IO (BufferObject,Ptr Float,Int) +setupVBOPointers (vbo,_,vsize) = do + thePtr <- mallocArray (vsize * numDrawableElements) + return (vbo,thePtr,vsize) + +setupArrayBuffer :: (BufferObject,GLuint,Int) -> IO () +setupArrayBuffer (vbo,aloc,i) = do + bindBuffer ArrayBuffer $= Just vbo + vertexAttribPointer (AttribLocation aloc) $= + ( ToFloat + , VertexArrayDescriptor (fromIntegral i) + Float + (fromIntegral $ floatSize * i) + (bufferOffset 0) + ) + vertexAttribArray (AttribLocation aloc) $= Enabled + + loadTextures :: IO [Image PixelRGBA8] loadTextures = do -- echarMap <- readImage "data/texture/smudgedDirt.png" @@ -125,6 +158,10 @@ doPreload' = do generateMipmap' Texture2D textureFilter Texture2D $= ((Linear',Just Linear') , Nearest) + trivao <- 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)] @@ -158,6 +195,10 @@ doPreload' = do , _circShader = cs , _arcShader = as , _fadeCircleShader = fcs + , _triVAO = trivao + , _textVAO' = textvao + , _circVAO' = circvao + , _arcVAO' = arcvao , _basicVAO = basicVAO , _textVAO = textVAO , _circVAO = circVAO diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index eaac79e15..b555d1f9e 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -240,24 +240,31 @@ bindArrayBuffers numVs ps = do bindBuffer ArrayBuffer $= Just bo bufferData ArrayBuffer $= (fromIntegral $ fSize * numVs * i, ptr, StreamDraw) +twoPtrsVAO :: VAO -> (Ptr Float, Ptr Float) +twoPtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of + (a:b:_) -> (a,b) +threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float) +threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of + (a:b:c:_) -> (a,b,c) + renderPicture' :: PreloadData -> Float -> (Float,Float) -> Picture -> IO () renderPicture' pdata zoom (winx,winy) pic = do let firstIndex = 0 (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) - <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata) - (_ptrCharPos pdata, _ptrCharCol pdata, _ptrCharTex pdata) - (_ptrCircPos pdata, _ptrCircCol pdata, _ptrCircSca pdata) +-- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata) + <- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata) + (threePtrsVAO $ _textVAO' pdata) + (threePtrsVAO $ _circVAO' pdata) (_ptrLinePos pdata, _ptrLineCol pdata) - (_ptrArcPos pdata, _ptrArcCol pdata, _ptrArcSca pdata) + (threePtrsVAO $ _arcVAO' pdata) ) $ picToFTree pic depthFunc $= Just Less -- draw triangles currentProgram $= Just (_basicShader pdata) - bindArrayBuffers nTriVs [(_posVBO pdata, _ptrPosVBO pdata, 3) - ,(_colVBO pdata, _ptrColVBO pdata, 4) - ] + bindVertexArrayObject $= Just (_vao $ _triVAO pdata) + bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata 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 @@ -270,32 +277,20 @@ renderPicture' pdata zoom (winx,winy) pic = do currentProgram $= Just (_circShader pdata) uniform (_uniWinSize pdata) $= Vector2 winx winy uniform (_csZoomUni pdata) $= zoom - bindVertexArrayObject $= Just (_circVAO pdata) - bindArrayBuffers numCircVs - [(_posVBO pdata, _ptrCircPos pdata, 3) - ,(_colVBO pdata, _ptrCircCol pdata, 4) - ,(_texVBO pdata, _ptrCircSca pdata, 1) - ] + 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 (_arcVAO pdata) - bindArrayBuffers nArcVs - [(_posVBO pdata, _ptrArcPos pdata, 3) - ,(_colVBO pdata, _ptrArcCol pdata, 4) - ,(_texVBO pdata, _ptrArcSca pdata, 4) - ] + bindVertexArrayObject $= Just (_vao $ _arcVAO' pdata) + bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO' pdata drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nArcVs) -- draw text currentProgram $= Just (_textShader pdata) - bindVertexArrayObject $= Just (_textVAO pdata) - bindArrayBuffers nTextVs - [(_posVBO pdata, _ptrCharPos pdata, 3) - ,(_colVBO pdata, _ptrCharCol pdata, 4) - ,(_texVBO pdata, _ptrCharTex pdata, 2) - ] + bindVertexArrayObject $= Just (_vao $ _textVAO' pdata) + bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO' pdata drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs) bufferOffset :: Integral a => a -> Ptr b