Start refactor of pointers into a vao datatype

This commit is contained in:
2021-02-20 09:17:56 +01:00
parent 9ff7810a2d
commit fa6f2f22f9
2 changed files with 62 additions and 26 deletions
+20 -25
View File
@@ -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