Move texture objects to openglraw

This commit is contained in:
2023-03-09 17:54:11 +00:00
parent 44b56ed163
commit 1d6fdd7eb1
9 changed files with 178 additions and 124 deletions
+16 -13
View File
@@ -13,6 +13,8 @@ import Control.Monad.Primitive
newtype FBO = FBO {_unFBO :: GLuint}
newtype TO = TO {_unTO :: GLuint}
data RenderData = RenderData
{ _lightingWallShadShader :: FullShader
, _lightingLineShadowShader :: FullShader
@@ -33,22 +35,23 @@ data RenderData = RenderData
, _shapeEBO :: EBO
, _silhouetteEBO :: EBO
, _pictureShaders :: MV.MVector (PrimState IO) FullShader
, _fbo2 :: (FBO, TextureObject)
, _fbo3 :: (FBO, TextureObject)
, _fboHalf1 :: (FBO, TextureObject)
, _fboHalf2 :: (FBO, TextureObject)
, _fboHalf3 :: (FBO, TextureObject)
, _fboBase :: (FBO, (TextureObject, TextureObject))
, _fboCloud :: (FBO, (TextureObject, TextureObject))
, _fboBloom :: (FBO, TextureObject)
, _fboColor :: (FBO, TextureObject)
, _fboPos :: (FBO, TextureObject)
, _fboLighting :: (FBO, TextureObject)
, _fboLightingHigh :: (FBO, TextureObject)
, _fboShadow :: (FBO, (TextureObject,TextureObject))
, _fbo2 :: (FBO, TO)
, _fbo3 :: (FBO, TO)
, _fboHalf1 :: (FBO, TO)
, _fboHalf2 :: (FBO, TO)
, _fboHalf3 :: (FBO, TO)
, _fboBase :: (FBO, (TO, TO))
, _fboCloud :: (FBO, (TO, TO))
, _fboBloom :: (FBO, TO)
, _fboColor :: (FBO, TO)
, _fboPos :: (FBO, TO)
, _fboLighting :: (FBO, TO)
, _fboLightingHigh :: (FBO, TO)
, _fboShadow :: (FBO, (TO,TO))
, _rboBaseBloom :: GLuint -- RenderbufferObject id
, _matUBO :: GLuint -- BufferObject id
}
makeLenses ''RenderData
makeLenses ''FBO
makeLenses ''TO
+10 -5
View File
@@ -167,7 +167,8 @@ doDrawing win pdata u = do
--bindFramebuffer Framebuffer $= pdata ^. fboBase . _1 --fst (_fboBase pdata)
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
--textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata)
--textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata)
glBindTexture GL_TEXTURE_2D (pdata ^. fboLighting . _2 . unTO) -- Just (snd $ _fboLighting pdata)
blend $= Enabled
blendFunc $= (Zero, OneMinusSrcColor)
drawShader (_fullscreenShader pdata) 4
@@ -187,7 +188,8 @@ doDrawing win pdata u = do
--bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboHalf1 pdata)))
depthFunc $= Just Always
textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
--textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
glBindTexture GL_TEXTURE_2D (pdata ^. fboBloom . _2 . unTO) -- Just (snd $ _fboBloom pdata)
blend $= Disabled
drawShader (_bloomBlurShader pdata) 4
replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
@@ -238,7 +240,8 @@ doDrawing win pdata u = do
depthMask $= Disabled
drawBuffers $= [FBOColorAttachment 0, NoBuffers]
depthFunc $= Just Always
textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
--textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboLighting pdata)
blend $= Enabled
--blendFunc $= (Zero, OneMinusSrcAlpha)
blendFuncSeparate $= ((Zero, OneMinusSrcColor), (Zero, One))
@@ -250,11 +253,13 @@ doDrawing win pdata u = do
--Draw blurred bloom onto base buffer
blend $= Enabled
blendFunc $= (SrcAlpha, One)
textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
--textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
glBindTexture GL_TEXTURE_2D (_unTO . snd $ _fboHalf1 pdata)
drawShader (_fullscreenShader pdata) 4
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
--draw shadowed clouds onto base buffer
textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata)
--textureBinding Texture2D $= Just (fst $ snd $ _fboCloud pdata)
glBindTexture GL_TEXTURE_2D (_unTO . fst . snd $ _fboCloud pdata)
drawShader (_fullscreenShader pdata) 4
--set viewport for radial distortion
setViewportSize (round winx) (round winy)
+30 -22
View File
@@ -6,6 +6,7 @@ module Framebuffer.Setup (
setupShadowFramebuffer,
) where
import Unsafe.Coerce
import Data.Preload.Render
import GLHelp
import Graphics.GL.Core45
@@ -14,68 +15,75 @@ import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
setupTextureFramebuffer ::
GLsizei ->
GLsizei ->
IO (FBO, TextureObject)
IO (FBO, TO)
{-# INLINE setupTextureFramebuffer #-}
setupTextureFramebuffer x y = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
fboTO <- genObjectName
textureBinding Texture2D $= Just fboTO
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y
textureFilter Texture2D $= minMagFilter
fboName <- mglCreate glCreateFramebuffers
--fboTO <- genObjectName
to <- mglCreate (glCreateTextures GL_TEXTURE_2D)
--textureBinding Texture2D $= Just fboTO
--glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y
glTextureStorage2D to 1 GL_RGBA8 x y
glTextureParameteri to GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST)
glTextureParameteri to GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST)
--textureFilter Texture2D $= minMagFilter
--framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0
glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 (unTexture fboTO) 0
glNamedFramebufferTexture fboName GL_COLOR_ATTACHMENT0 to 0
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
return (FBO fboName, fboTO)
return (FBO fboName, TO to)
setupShadowFramebuffer :: IO (FBO, (TextureObject, TextureObject))
setupShadowFramebuffer :: IO (FBO, (TO, TO))
setupShadowFramebuffer = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName
toName2 <- genObjectName
fboName <- mglCreate glCreateFramebuffers
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
--textureBinding Texture2DArray $= Just toName
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
return (FBO fboName, (toName, toName2))
return (FBO fboName, (TO to1,TO to2))
setupFramebufferGivenStencil ::
GLuint -> -- RenderbufferObject
IO (FBO, TextureObject)
IO (FBO, TO)
{-# INLINE setupFramebufferGivenStencil #-}
setupFramebufferGivenStencil rboName = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName
fboName <- mglCreate glCreateFramebuffers
--toName <- genObjectName
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus
return (FBO fboName, toName)
return (FBO fboName, TO to1)
setupFramebuffer2GivenStencil ::
GLuint -> -- RenderbufferObject
IO (FBO, (TextureObject, TextureObject))
IO (FBO, (TO, TO))
setupFramebuffer2GivenStencil rboName = do
--fboName <- genObjectName
--bindFramebuffer Framebuffer $= fboName
fboName <- mglCreateSingle glCreateFramebuffers
toName <- genObjectName
toName2 <- genObjectName
fboName <- mglCreate glCreateFramebuffers
-- toName <- genObjectName
-- toName2 <- genObjectName
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
--framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
glNamedFramebufferRenderbuffer fboName GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> putStrLn $ "Framebuffer with given stencil and two texture objects status: " ++ show fboStatus
return (FBO fboName, (toName, toName2))
return (FBO fboName, (TO to1, TO to2))
minMagFilter :: ((TextureFilter, Maybe TextureFilter), TextureFilter)
minMagFilter = ((Nearest, Nothing), Nearest)
+90 -57
View File
@@ -8,6 +8,8 @@ module Framebuffer.Update
where
import Data.Preload.Render
import GLHelp
import Unsafe.Coerce
import Foreign.Marshal.Array
import Graphics.Rendering.OpenGL
import Graphics.GL.Core45
@@ -24,14 +26,14 @@ sizeFBOs
-> IO RenderData
sizeFBOs xsize ysize xfull yfull rdata = do
resizeRBO (_rboBaseBloom rdata) xsize ysize
rdata' <- foldM (updateFBOTO2 xsize ysize minMagFilter GL_RGBA8 GL_RGBA16F) rdata [fboBase,fboCloud]
>>= flip (foldM (updateFBOTO xsize ysize minMagFilter GL_RGBA8))
rdata' <- foldM (updateFBOTO2 xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8 GL_RGBA16F) rdata [fboBase,fboCloud]
>>= flip (foldM (updateFBOTO xsize ysize GL_NEAREST GL_NEAREST GL_RGBA8))
[fboColor,fboLighting,fboLightingHigh]
rdata'' <- foldM (updateFBOTO xsize ysize linMinMagFilter GL_RGBA16F) rdata'
rdata'' <- foldM (updateFBOTO xsize ysize GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata'
[fboBloom, fboPos]
rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata''
rdata''' <- foldM (updateFBOTO xfull yfull GL_NEAREST GL_NEAREST GL_RGBA8) rdata''
[fbo2, fbo3]
rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata'''
rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) GL_LINEAR_MIPMAP_LINEAR GL_LINEAR GL_RGBA16F) rdata'''
[fboHalf1,fboHalf2,fboHalf3]
newShadowFBO <- resizeShadowFBO (rdata ^. fboShadow) xsize ysize
return $ rdata4 & fboShadow .~ newShadowFBO
@@ -53,111 +55,142 @@ resizeRBO rboName xsize ysize = do
updateFBOTO
:: Int
-> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ minification filter
-> GLenum -- ^ magnification filter
-> GLenum -- ^ internal color format
-> RenderData
-> ALens' RenderData (FBO, TextureObject)
-> ALens' RenderData (FBO, TO)
-> IO RenderData
updateFBOTO xsize ysize mmfilt inFormat pdata target = do
newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize mmfilt inFormat
updateFBOTO xsize ysize minfilt magfilt inFormat pdata target = do
newfbo2 <- resizeFBOTO (pdata ^# target) xsize ysize minfilt magfilt inFormat
return $ storing target newfbo2 pdata
updateFBOTO2
:: Int
-> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ minification filter
-> GLenum -- ^ magnification filter
-> GLenum -- ^ internal color format texture1
-> GLenum -- ^ internal color format texture2
-> RenderData
-> ALens' RenderData (FBO, (TextureObject,TextureObject))
-> ALens' RenderData (FBO, (TO,TO))
-> IO RenderData
updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do
newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2
updateFBOTO2 xsize ysize minfilt magfilt inFormat1 inFormat2 pdata target = do
newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize minfilt magfilt inFormat1 inFormat2
return $ storing target newfbo2 pdata
-- note we only really "change" the texture objects
resizeShadowFBO :: (FBO, (TextureObject,TextureObject))
-> Int -> Int -> IO (FBO, (TextureObject,TextureObject))
resizeShadowFBO :: (FBO, (TO,TO))
-> Int -> Int -> IO (FBO, (TO,TO))
resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
--bindFramebuffer Framebuffer $= fboname
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboname)
deleteObjectName oldto1
deleteObjectName oldto2
to1 <- genObjectName
to2 <- genObjectName
textureBinding Texture2DArray $= Just to1
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_RGBA8 xsize' ysize' 10
textureFilter Texture2DArray $= minMagFilter
glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 (unTexture to1) 0
textureBinding Texture2DArray $= Just to2
glTexStorage3D GL_TEXTURE_2D_ARRAY 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
textureFilter Texture2DArray $= minMagFilter
glNamedFramebufferTexture (_unFBO fboname) GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0
mglDelete glDeleteTextures $ _unTO oldto1
mglDelete glDeleteTextures $ _unTO oldto2
--deleteObjectName oldto1
--deleteObjectName oldto2
--to1 <- genObjectName
--to2 <- genObjectName
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D_ARRAY)
--textureBinding Texture2DArray $= Just to1
glTextureStorage3D to1 1 GL_RGBA8 xsize' ysize' 10
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST)
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST)
--textureFilter Texture2DArray $= minMagFilter
glNamedFramebufferTexture (_unFBO fboname) GL_COLOR_ATTACHMENT0 to1 0
--textureBinding Texture2DArray $= Just to2
glTextureStorage3D to2 1 GL_DEPTH24_STENCIL8 xsize' ysize' 10
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce GL_NEAREST)
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce GL_NEAREST)
--textureFilter Texture2DArray $= minMagFilter
glNamedFramebufferTexture (_unFBO fboname) GL_DEPTH_STENCIL_ATTACHMENT to2 0
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
return (fboname,(to1,to2))
return (fboname,(TO to1,TO to2))
-- this currently has one mipmap level?
resizeFBOTO2
:: (FBO , (TextureObject,TextureObject))
:: (FBO , (TO,TO))
-> Int
-> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ minification filter
-> GLenum -- ^ magnification filter
-> GLenum -- ^ internal color format1
-> GLenum -- ^ internal color format2
-> IO (FBO, (TextureObject,TextureObject))
resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 = do
-> IO (FBO, (TO,TO))
resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize minfilt magfilt inFormat1 inFormat2 = do
--bindFramebuffer Framebuffer $= fboName
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
deleteObjectName toOld1
deleteObjectName toOld2
toName1 <- genObjectName
textureBinding Texture2D $= Just toName1
glTexStorage2D GL_TEXTURE_2D 1 inFormat1 xsize' ysize'
textureFilter Texture2D $= mmfilt
framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName1 0
toName2 <- genObjectName
textureBinding Texture2D $= Just toName2
glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize'
textureFilter Texture2D $= mmfilt
mglDelete glDeleteTextures $ _unTO toOld1
mglDelete glDeleteTextures $ _unTO toOld2
-- deleteObjectName toOld1
-- deleteObjectName toOld2
to1 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
to2 <- mglCreate (glCreateTextures GL_TEXTURE_2D)
--toName1 <- genObjectName
--textureBinding Texture2D $= Just toName1
--glTexStorage2D GL_TEXTURE_2D 1 inFormat1 xsize' ysize'
glTextureStorage2D to1 1 inFormat1 xsize' ysize'
glTextureParameteri to1 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
glTextureParameteri to1 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
--textureFilter Texture2D $= mmfilt
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 to1 0
--framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName1 0
glTextureStorage2D to2 1 inFormat2 xsize' ysize'
glTextureParameteri to2 GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
glTextureParameteri to2 GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
--toName2 <- genObjectName
--textureBinding Texture2D $= Just toName2
--glTexStorage2D GL_TEXTURE_2D 1 inFormat2 xsize' ysize'
--textureFilter Texture2D $= mmfilt
--framebufferTexture2D Framebuffer (ColorAttachment 1) Texture2D toName2 0
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT1 (unTexture toName2) 0
drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1]
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT1 to2 0
withArray [GL_COLOR_ATTACHMENT0,GL_COLOR_ATTACHMENT1] $ \ptr ->
glNamedFramebufferDrawBuffers (_unFBO fboName) 2 ptr
--drawBuffers $= [FBOColorAttachment 0,FBOColorAttachment 1]
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
return (fboName, (toName1,toName2))
return (fboName, (TO to1,TO to2))
resizeFBOTO
:: (FBO , TextureObject)
:: (FBO , TO)
-> Int
-> Int
-> ((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ minification filter
--((TextureFilter, Maybe TextureFilter),TextureFilter)
-> GLenum -- ^ magnification filter
-> GLenum -- ^ internal color format
-> IO (FBO, TextureObject)
resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
-> IO (FBO, TO)
resizeFBOTO (fboName,oldto) xsize ysize minfilt magfilt inFormat = do
--bindFramebuffer Framebuffer $= fboName
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fboName)
let xsize' = fromIntegral xsize
ysize' = fromIntegral ysize
deleteObjectName toOld
toName <- genObjectName
textureBinding Texture2D $= Just toName
glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize'
textureFilter Texture2D $= mmfilt
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 (unTexture toName) 0
mglDelete glDeleteTextures $ _unTO oldto
to <- mglCreate (glCreateTextures GL_TEXTURE_2D)
--toName <- genObjectName
--textureBinding Texture2D $= Just toName
--glTexStorage2D GL_TEXTURE_2D 1 inFormat xsize' ysize'
glTextureStorage2D to 1 inFormat xsize' ysize'
glTextureParameteri to GL_TEXTURE_MIN_FILTER (unsafeCoerce minfilt)
glTextureParameteri to GL_TEXTURE_MAG_FILTER (unsafeCoerce magfilt)
--textureFilter Texture2D $= mmfilt
glNamedFramebufferTexture (_unFBO fboName) GL_COLOR_ATTACHMENT0 to 0
--framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0
fboStatus <- framebufferStatus Framebuffer
case fboStatus of
Complete -> return ()
_ -> error $ "after resize, resizeFBOTO framebuffer status:" ++ show fboStatus
return (fboName, toName)
return (fboName, TO to)
minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)
minMagFilter = ((Nearest,Nothing),Nearest)
+5 -3
View File
@@ -5,13 +5,15 @@ import Foreign.Storable
import Graphics.GL.Core45
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
mglCreateSingle :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint
mglCreateSingle f = do
mglCreate :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint
mglCreate f = do
alloca $ \nameptr -> do
f 1 nameptr
peek nameptr
mglDelete :: (GLsizei -> Ptr GLuint -> IO ()) -> GLuint -> IO ()
mglDelete f i = with i $ \ptr -> f 1 ptr
unTexture :: TextureObject -> GLuint
unTexture (TextureObject t) = t
+13 -13
View File
@@ -27,11 +27,11 @@ numDrawableWalls = 5000
preloadRender :: IO RenderData
preloadRender = do
-- set up uniform buffer object
theUBO <- mglCreateSingle glCreateBuffers
theUBO <- mglCreate glCreateBuffers
glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
-- setup wall points VBO, VAOs and shaders
wpVBOname <- mglCreateSingle glCreateBuffers
wpVBOname <- mglCreate glCreateBuffers
wpVBOptr <- mallocArray (8 * numDrawableWalls)
glNamedBufferData wpVBOname
( fromIntegral $ floatSize * numDrawableWalls * 8)
@@ -40,19 +40,19 @@ preloadRender = do
let wpVBO = VBO{_vboName = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
-- wpVAOname <- genObjectName
-- bindVertexArrayObject $= Just wpVAOname
wpVAOname <- mglCreateSingle glCreateVertexArrays
wpVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray wpVAOname
setupVertexAttribPointer wpVAOname wpVBOname 0 4 8 0
--wpColVAOname <- genObjectName
--bindVertexArrayObject $= Just wpColVAOname
wpColVAOname <- mglCreateSingle glCreateVertexArrays
wpColVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray wpColVAOname
setupVertexAttribPointer wpColVAOname wpVBOname 0 4 8 0
setupVertexAttribPointer wpColVAOname wpVBOname 1 4 8 4
let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO}
wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO}
-- setup window points VBO, VAOs and shaders
winVBOname <- mglCreateSingle glCreateBuffers
winVBOname <- mglCreate glCreateBuffers
winVBOptr <- mallocArray (8 * numDrawableWalls)
glNamedBufferData wpVBOname
( fromIntegral $ floatSize * numDrawableWalls * 8)
@@ -61,21 +61,21 @@ preloadRender = do
let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--winColVAOname <- genObjectName
--bindVertexArrayObject $= Just winColVAOname
winColVAOname <- mglCreateSingle glCreateVertexArrays
winColVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray winColVAOname
setupVertexAttribPointer winColVAOname winVBOname 0 4 8 0
setupVertexAttribPointer winColVAOname winVBOname 1 4 8 4
let winColVAO = VAO{_vaoName = winColVAOname, _vaoVBO = winVBO}
-- setup shape geometry/cap VBO and two VAOs
shEBOptr <- mallocArray numDrawableElements
shEBOname <- mglCreateSingle glCreateBuffers
shEBOname <- mglCreate glCreateBuffers
glNamedBufferData
shEBOname
( fromIntegral $ glushortSize * numDrawableElements)
nullPtr
GL_STREAM_DRAW
let shEBO = EBO{_eboName = shEBOname, _eboPtr = shEBOptr}
shVBOname <- mglCreateSingle glCreateBuffers
shVBOname <- mglCreate glCreateBuffers
shVBOptr <- mallocArray (7 * numDrawableElements)
glNamedBufferData shVBOname
( fromIntegral $ floatSize * numDrawableElements * 7)
@@ -84,7 +84,7 @@ preloadRender = do
let shVBO = VBO{_vboName = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
--shPosColVAOname <- genObjectName
--bindVertexArrayObject $= Just shPosColVAOname
shPosColVAOname <- mglCreateSingle glCreateVertexArrays
shPosColVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray shPosColVAOname
setupVertexAttribPointer shPosColVAOname shVBOname 0 3 7 0
setupVertexAttribPointer shPosColVAOname shVBOname 1 4 7 3
@@ -92,7 +92,7 @@ preloadRender = do
glVertexArrayElementBuffer shPosColVAOname shEBOname
--shPosVAOname <- genObjectName
--bindVertexArrayObject $= Just shPosVAOname
shPosVAOname <- mglCreateSingle glCreateVertexArrays
shPosVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray shPosVAOname
setupVertexAttribPointer shPosVAOname shVBOname 0 3 7 0
--bindBuffer ElementArrayBuffer $= Just shEBOname
@@ -102,11 +102,11 @@ preloadRender = do
--setup silhouette edge VAO
--shEdgeVAOname <- genObjectName
--bindVertexArrayObject $= Just shEdgeVAOname
shEdgeVAOname <- mglCreateSingle glCreateVertexArrays
shEdgeVAOname <- mglCreate glCreateVertexArrays
glBindVertexArray shEdgeVAOname
setupVertexAttribPointer shEdgeVAOname shVBOname 0 3 7 0
--setup ebo for silhouette edges
silEBOname <- mglCreateSingle glCreateBuffers
silEBOname <- mglCreate glCreateBuffers
silEBOptr <- mallocArray numDrawableElements
-- it may be important to bind this while the correct VAO is bound
glVertexArrayElementBuffer shEdgeVAOname silEBOname
@@ -175,7 +175,7 @@ preloadRender = do
framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600
rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers
rboBaseBloomName <- mglCreate glCreateRenderbuffers
glNamedRenderbufferStorage
rboBaseBloomName
GL_DEPTH24_STENCIL8
+10 -7
View File
@@ -45,7 +45,7 @@ createLightMap ::
-- | whether to draw object shadows or not
ObjectShadows ->
-- | the texture object giving positions
TextureObject ->
TO ->
(Point3 -> Float -> IO ()) -> -- attempt at drawing shadow not using geo shader
IO ()
createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUShadows = do
@@ -143,18 +143,20 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
-- assumes that vertices have already been sent to the shader
pingPongBetween ::
(FBO, TextureObject) ->
(FBO, TextureObject) ->
(FBO, TO) ->
(FBO, TO) ->
FullShader ->
IO ()
pingPongBetween (fb1, to1) (fb2, to2) fs = do
--bindFramebuffer Framebuffer $= fb2
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb2)
textureBinding Texture2D $= Just to1
--textureBinding Texture2D $= Just to1
glBindTexture GL_TEXTURE_2D (_unTO to1)
drawShader fs 4
--bindFramebuffer Framebuffer $= fb1
glBindFramebuffer GL_FRAMEBUFFER (_unFBO fb1)
textureBinding Texture2D $= Just to2
--textureBinding Texture2D $= Just to2
glBindTexture GL_TEXTURE_2D (_unTO to2)
drawShader fs 4
renderFoldable ::
@@ -178,8 +180,9 @@ renderLayer layer shads counts = do
where
ln = layerNum layer
bindTO :: TextureObject -> IO ()
bindTO t = textureBinding Texture2D $= Just t
bindTO :: TO -> IO ()
bindTO t = glBindTexture GL_TEXTURE_2D (_unTO t)
--textureBinding Texture2D $= Just t
bindFBO :: FBO -> IO ()
bindFBO fb = --bindFramebuffer Framebuffer $= fb
+2 -2
View File
@@ -38,7 +38,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do
let texdata = convertRGBA8 cmap
let wtex = fromIntegral $ imageWidth texdata
htex = fromIntegral $ imageHeight texdata
texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D
glTextureStorage2D texname nlev GL_RGBA8 wtex htex
VS.unsafeWith (imageData texdata) $ \ptr -> do
glTextureSubImage2D texname 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
@@ -69,7 +69,7 @@ addTextureArray texturePath shad = do
print err
Right cmap <- readImage texturePath
let texdata = convertRGBA8 cmap
texname <- mglCreateSingle $ glCreateTextures GL_TEXTURE_2D_ARRAY
texname <- mglCreate $ glCreateTextures GL_TEXTURE_2D_ARRAY
glTextureStorage3D texname 3 GL_RGBA8 32 32 64
VS.unsafeWith (imageData texdata) $ \ptr -> do
glTextureSubImage3D texname 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
+2 -2
View File
@@ -129,7 +129,7 @@ setupVAO = setupVAOSized numDrawableElements
setupVAOSized :: Int -> [Int] -> IO VAO
setupVAOSized ndraw sizes = do
vaoname <- mglCreateSingle glCreateVertexArrays
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
theVBO <- setupVBOSized ndraw vaoname sizes
return $
@@ -142,7 +142,7 @@ setupVBOSized :: Int -> GLuint -> [Int] -> IO VBO
setupVBOSized ndraw vao sizes = do
--vboName <- genObjectName
--bindBuffer ArrayBuffer $= Just vboName
vboname <- mglCreateSingle glCreateBuffers
vboname <- mglCreate glCreateBuffers
glBindBuffer GL_ARRAY_BUFFER vboname
forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
setupVertexAttribPointer vao vboname loc siz strd off