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

Move texture objects to openglraw

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