Implement background texture

This commit is contained in:
2021-02-21 12:00:40 +01:00
parent df0f07fbca
commit 2f7ab06aa4
6 changed files with 96 additions and 42 deletions
+15 -2
View File
@@ -247,8 +247,8 @@ 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
renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO ()
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) pic = do
let firstIndex = 0
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
@@ -261,6 +261,18 @@ renderPicture' pdata zoom (winx,winy) pic = do
) $ picToFTree pic
depthFunc $= Just Less
currentProgram $= Just (_backShader pdata)
bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
pokeTwoOff backPtr2 0 (winx,winy)
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
textureBinding Texture2D $= Just (_textures pdata !! 1)
drawArrays Points (fromIntegral 0) (fromIntegral 1)
-- draw triangles
currentProgram $= Just (_basicShader pdata)
bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
@@ -289,6 +301,7 @@ renderPicture' pdata zoom (winx,winy) pic = do
currentProgram $= Just (_textShader pdata)
bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
textureBinding Texture2D $= Just (_textures pdata !! 0)
drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
bufferOffset :: Integral a => a -> Ptr b