justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Start refactor of pointers into a vao datatype

Browse Source
This commit is contained in:
jgk
2021-02-20 09:17:56 +01:00
parent 9ff7810a2d
commit fa6f2f22f9
2 changed files with 62 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Preload.hs
+42 -1
View File
@@ -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
src/Picture/Render.hs
+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