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

Implement background texture

Browse Source
This commit is contained in:
jgk
2021-02-21 12:00:40 +01:00
parent df0f07fbca
commit 2f7ab06aa4
6 changed files with 96 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Preload.hs
+51 -33
View File
@@ -17,18 +17,20 @@ import Foreign
import Shaders
data PreloadData = PreloadData
{ _charMap :: Image PixelRGBA8
-- , _textures :: [Image PixelRGBA8]
{ --_charMap :: Image PixelRGBA8
_textures :: [TextureObject]
, _basicShader :: Program
, _textShader :: Program
, _circShader :: Program
, _arcShader :: Program
, _fadeCircleShader :: Program
, _backShader :: Program
, _triVAO :: VAO
, _lineVAO :: VAO
, _textVAO :: VAO
, _circVAO :: VAO
, _arcVAO :: VAO
, _backVAO :: VAO
, _posVBO :: BufferObject
, _colVBO :: BufferObject
, _texVBO :: BufferObject
@@ -36,6 +38,8 @@ data PreloadData = PreloadData
, _csZoomUni :: UniformLocation
, _asWinUni :: UniformLocation
, _asZoomUni :: UniformLocation
, _dummyVBO :: BufferObject
, _dummyPtr :: Ptr Float
}
data VAO = VAO
{ _vao :: VertexArrayObject
@@ -47,24 +51,8 @@ makeLenses ''VAO
floatSize = sizeOf (0.5 :: GLfloat)
setupVAO :: [(BufferObject,GLuint,Int)] -> IO VertexArrayObject
setupVAO :: [(BufferObject,GLuint,Int)] -> IO VAO
setupVAO ps = do
theVAO <- genObjectName
bindVertexArrayObject $= Just theVAO
forM_ ps $ \(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
return theVAO
setupVAO' :: [(BufferObject,GLuint,Int)] -> IO VAO
setupVAO' ps = do
theVAO <- genObjectName
bindVertexArrayObject $= Just theVAO
forM_ ps setupArrayBuffer
@@ -114,6 +102,7 @@ doPreload' = do
cs <- makeCircleShader
as <- makeArcShader
fcs <- makeFadeShader
bgs <- makeBackgroundShader
winSizeUni <- GL.uniformLocation cs "winSize"
zoomUni <- GL.uniformLocation cs "zoom"
@@ -127,12 +116,19 @@ doPreload' = do
colVBO <- genObjectName
texVBO <- genObjectName
--the following vbo is set up to contain one fixed vertex
dummyvbo <- genObjectName
dummyptr <- malloc
poke dummyptr 0
bindBuffer ArrayBuffer$= Just dummyvbo
bufferData ArrayBuffer$= (fromIntegral floatSize, dummyptr, StaticDraw)
-- load charmap as texture
-- Right cmap <- readImage "data/texture/smudgedDirt.png"
Right cmap <- readImage "data/texture/charMap.png"
let tex = convertRGBA8 cmap
texo <- genObjectName
textureBinding Texture2D $= Just texo
chartex <- genObjectName
textureBinding Texture2D $= Just chartex
let texData = V.toList $ imageData tex
wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex
@@ -142,27 +138,48 @@ doPreload' = do
generateMipmap' Texture2D
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)]
Right cmap' <- readImage "data/texture/smudgedDirt.png"
let dirt = convertRGBA8 cmap'
dirttex <- genObjectName
textureBinding Texture2D $= Just dirttex
let texData' = V.toList $ imageData dirt
wtex' = fromIntegral $ imageWidth dirt
htex' = fromIntegral $ imageHeight dirt
withArray texData' $ \ptr -> do
texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D wtex' htex') 0
(PixelData RGBA UnsignedByte ptr)
generateMipmap' Texture2D
textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
--textureBinding Texture2D $= Just chartex
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)]
backgroundvao <- setupVAO [(posVBO,0,4),(colVBO,1,2)]
return $ PreloadData
{ _charMap = convertRGBA8 cmap
, _basicShader = bs
{ -- _charMap = convertRGBA8 cmap
_textures = [chartex,dirttex]
,_basicShader = bs
, _textShader = ts
, _circShader = cs
, _arcShader = as
, _fadeCircleShader = fcs
, _triVAO = trivao
, _textVAO = textvao
, _circVAO = circvao
, _arcVAO = arcvao
, _lineVAO = linevao
, _backShader = bgs
, _triVAO = trivao
, _textVAO = textvao
, _circVAO = circvao
, _arcVAO = arcvao
, _lineVAO = linevao
, _backVAO = backgroundvao
, _posVBO = posVBO
, _colVBO = colVBO
, _texVBO = texVBO
, _dummyVBO = dummyvbo
, _dummyPtr = dummyptr
, _uniWinSize = winSizeUni
, _csZoomUni = zoomUni
, _asWinUni = asWinSizeUniLoc
@@ -179,3 +196,4 @@ cleanUpPreload pd = do
mapM_ free $ vaoPointers $ _circVAO pd
mapM_ free $ vaoPointers $ _arcVAO pd
mapM_ free $ vaoPointers $ _lineVAO pd
free $ _dummyPtr pd
src/Picture/Render.hs
+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
src/Shaders.hs
+11
View File
@@ -8,6 +8,7 @@ module Shaders
,makeFadeShader
,makeCircleShader
,makeArcShader
,makeBackgroundShader
)
where
import Graphics.Rendering.OpenGL
@@ -64,6 +65,16 @@ makeFadeShader = do
gsSource <- BS.readFile "shader/fadeCircle.geom"
fsSource <- BS.readFile "shader/fadeCircle.frag"
makeShaderProgram [(VertexShader, vsSource )
,(GeometryShader, gsSource )
,(FragmentShader, fsSource )
]
makeBackgroundShader :: IO Program
makeBackgroundShader = do
vsSource <- BS.readFile "shader/background.vert"
gsSource <- BS.readFile "shader/background.geom"
fsSource <- BS.readFile "shader/background.frag"
makeShaderProgram [(VertexShader, vsSource )
,(GeometryShader, gsSource )
,(FragmentShader, fsSource )