diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 5bd781f1a..f7f5e7e1f 100644 --- a/src/Data/Preload/Render.hs +++ b/src/Data/Preload/Render.hs @@ -12,25 +12,25 @@ import qualified Data.Vector.Mutable as MV import Control.Monad.Primitive data RenderData = RenderData - { _lightingWallShadShader :: FullShader' - , _lightingLineShadowShader :: FullShader' - , _positionalBlankShader :: FullShader' - , _lightingCapShader :: FullShader' - , _wallBlankShader :: FullShader' - , _windowShader :: FullShader' - , _wallTextureShader :: FullShader' - , _textureArrayShader :: FullShader' - , _fullscreenShader :: FullShader' - , _lightingTextureShader :: FullShader' - --, _fullscreenAlphaHalveShader :: FullShader' - , _bloomBlurShader :: FullShader' - , _colorBlurShader :: FullShader' - , _barrelShader :: FullShader' - , _grayscaleShader :: FullShader' - , _shapeShader :: FullShader' + { _lightingWallShadShader :: FullShader + , _lightingLineShadowShader :: FullShader + , _positionalBlankShader :: FullShader + , _lightingCapShader :: FullShader + , _wallBlankShader :: FullShader + , _windowShader :: FullShader + , _wallTextureShader :: FullShader + , _textureArrayShader :: FullShader + , _fullscreenShader :: FullShader + , _lightingTextureShader :: FullShader + --, _fullscreenAlphaHalveShader :: FullShader + , _bloomBlurShader :: FullShader + , _colorBlurShader :: FullShader + , _barrelShader :: FullShader + , _grayscaleShader :: FullShader + , _shapeShader :: FullShader , _shapeEBO :: EBO , _silhouetteEBO :: EBO - , _pictureShaders :: MV.MVector (PrimState IO) FullShader' + , _pictureShaders :: MV.MVector (PrimState IO) FullShader , _fbo2 :: (FramebufferObject, TextureObject) , _fbo3 :: (FramebufferObject, TextureObject) , _fboHalf1 :: (FramebufferObject, TextureObject) @@ -41,11 +41,11 @@ data RenderData = RenderData , _fboBloom :: (FramebufferObject, TextureObject) , _fboColor :: (FramebufferObject, TextureObject) , _fboPos :: (FramebufferObject, TextureObject) - , _rboBaseBloom :: RenderbufferObject + , _rboBaseBloom :: GLuint -- RenderbufferObject id , _fboLighting :: (FramebufferObject, TextureObject) , _fboLightingHigh :: (FramebufferObject, TextureObject) , _fboShadow :: (FramebufferObject, (TextureObject,TextureObject)) - , _matUBO :: GLuint + , _matUBO :: GLuint -- BufferObject id } makeLenses ''RenderData diff --git a/src/Framebuffer/Setup.hs b/src/Framebuffer/Setup.hs index baa9956ca..311d49180 100644 --- a/src/Framebuffer/Setup.hs +++ b/src/Framebuffer/Setup.hs @@ -40,28 +40,30 @@ setupShadowFramebuffer = do return (fboName,(toName,toName2)) setupFramebufferGivenStencil - :: RenderbufferObject + :: GLuint -- RenderbufferObject -> IO (FramebufferObject, TextureObject) {-# INLINE setupFramebufferGivenStencil #-} setupFramebufferGivenStencil rboName = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName toName <- genObjectName - framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName + --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName + glFramebufferRenderbuffer GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () _ -> putStrLn $ "Framebuffer with given stencil status: " ++ show fboStatus return (fboName,toName) setupFramebuffer2GivenStencil - :: RenderbufferObject + :: GLuint -- RenderbufferObject -> IO (FramebufferObject, (TextureObject,TextureObject)) setupFramebuffer2GivenStencil rboName = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName toName <- genObjectName toName2 <- genObjectName - framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName + --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName + glFramebufferRenderbuffer GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT GL_RENDERBUFFER rboName fboStatus <- framebufferStatus Framebuffer case fboStatus of Complete -> return () diff --git a/src/Framebuffer/Update.hs b/src/Framebuffer/Update.hs index e5a73cfa5..8e5e52cbc 100644 --- a/src/Framebuffer/Update.hs +++ b/src/Framebuffer/Update.hs @@ -9,7 +9,7 @@ where import Data.Preload.Render import Graphics.Rendering.OpenGL -import Graphics.GL.Core43 +import Graphics.GL.Core45 --import Foreign import Control.Lens import Control.Monad @@ -37,15 +37,20 @@ sizeFBOs xsize ysize xfull yfull rdata = do -- return rdata4 resizeRBO - :: RenderbufferObject + :: GLuint -- RenderbufferObject -> Int -> Int -> IO () resizeRBO rboName xsize ysize = do let xsize' = fromIntegral xsize ysize' = fromIntegral ysize - bindRenderbuffer Renderbuffer $= rboName - renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize') + --bindRenderbuffer Renderbuffer $= rboName + --renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize') + glNamedRenderbufferStorage + rboName + GL_DEPTH24_STENCIL8 + xsize' + ysize' updateFBOTO :: Int -> Int diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 456425098..07ea9ebe1 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -28,11 +28,7 @@ preloadRender :: IO RenderData preloadRender = do -- set up uniform buffer object theUBO <- mglCreateSingle glCreateBuffers - --glBindBuffer GL_UNIFORM_BUFFER theUBO - --bindBuffer UniformBuffer $= Just theUBO glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW - --bufferData UniformBuffer $= (64, nullPtr, StreamDraw) - --bindBufferBase IndexedUniformBuffer 0 $= Just theUBO glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO -- setup wall points VBO, VAOs and shaders wpVBOname <- mglCreateSingle glCreateBuffers @@ -58,11 +54,10 @@ preloadRender = do -- setup window points VBO, VAOs and shaders winVBOname <- mglCreateSingle glCreateBuffers winVBOptr <- mallocArray (8 * numDrawableWalls) - bufferData ArrayBuffer - $= ( fromIntegral $ floatSize * numDrawableWalls * 8 - , nullPtr - , StreamDraw - ) + glNamedBufferData wpVBOname + ( fromIntegral $ floatSize * numDrawableWalls * 8) + nullPtr + GL_STREAM_DRAW let winVBO = VBO{_vboName = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8} --winColVAOname <- genObjectName --bindVertexArrayObject $= Just winColVAOname @@ -180,9 +175,14 @@ preloadRender = do framebuf2 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600 - rboBaseBloomName <- genObjectName - bindRenderbuffer Renderbuffer $= rboBaseBloomName - renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) + rboBaseBloomName <- mglCreateSingle glCreateRenderbuffers + --bindRenderbuffer Renderbuffer $= rboBaseBloomName + --renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) + glNamedRenderbufferStorage + rboBaseBloomName + GL_DEPTH24_STENCIL8 + 800 + 600 fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName diff --git a/src/Render.hs b/src/Render.hs index cbf25abfb..0fe34f07c 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -145,7 +145,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh pingPongBetween :: (FramebufferObject, TextureObject) -> (FramebufferObject, TextureObject) -> - FullShader' -> + FullShader -> IO () pingPongBetween (fb1, to1) (fb2, to2) fs = do bindFramebuffer Framebuffer $= fb2 @@ -156,7 +156,7 @@ pingPongBetween (fb1, to1) (fb2, to2) fs = do drawShader fs 4 renderFoldable :: - MV.MVector (PrimState IO) FullShader' -> + MV.MVector (PrimState IO) FullShader -> Picture -> IO () renderFoldable shadV struct = do @@ -167,7 +167,7 @@ renderFoldable shadV struct = do ------------------------------end renderFoldable renderLayer :: Layer -> - MV.MVector (PrimState IO) FullShader' -> + MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () renderLayer layer shads counts = do diff --git a/src/Shader.hs b/src/Shader.hs index 03b8440af..e13c0db7f 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -21,7 +21,7 @@ import Control.Monad.Primitive import Foreign import Graphics.GL.Core45 -drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader' -> IO () +drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> IO () {-# INLINE drawShaderLay #-} drawShaderLay l countsVector shadIn fs = do i <- UMV.read countsVector shadIn @@ -40,7 +40,7 @@ drawShaderLay l countsVector shadIn fs = do (fromIntegral $ l*numSubElements) (fromIntegral i) -drawShader :: FullShader' -> Int -> IO () +drawShader :: FullShader -> Int -> IO () {-# INLINE drawShader #-} drawShader fs i = do --currentProgram $= Just (_shadProg fs) @@ -58,11 +58,11 @@ drawShader fs i = do 0 (fromIntegral i) -freeShaderPointers' :: FullShader' -> IO () +freeShaderPointers' :: FullShader -> IO () freeShaderPointers' = free . _vboPtr . _vaoVBO . _shadVAO' pokeBindFoldable - :: MV.MVector (PrimState IO) FullShader' + :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Picture -> IO () @@ -71,7 +71,7 @@ pokeBindFoldable shadV counts m = do bindShader shadV counts pokeBindFoldableLayer - :: MV.MVector (PrimState IO) FullShader' + :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Picture -> IO () @@ -79,10 +79,10 @@ pokeBindFoldableLayer shadV counts m = do pokeLayVerxs shadV counts m bindShaderLayers shadV counts -shadVBOptr :: FullShader' -> Ptr Float +shadVBOptr :: FullShader -> Ptr Float {-# INLINE shadVBOptr #-} shadVBOptr = _vboPtr . _vaoVBO . _shadVAO' -shadVBOptr' :: FullShader' -> Ptr Float +shadVBOptr' :: FullShader -> Ptr Float {-# INLINE shadVBOptr' #-} shadVBOptr' = _vboPtr . _vaoVBO . _shadVAO' diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 49d7d280d..f27dad943 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -21,10 +21,10 @@ import GLHelp -- I am not sure if this assumes that the shader is constructed directly before -- the texture is added... -addTexture :: String -> FullShader' -> IO FullShader' +addTexture :: String -> FullShader -> IO FullShader addTexture = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR -vaddTextureNoFilter :: String -> FullShader' -> IO FullShader' +vaddTextureNoFilter :: String -> FullShader -> IO FullShader vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST addTexture2D @@ -32,7 +32,7 @@ addTexture2D -> GLenum -- minfilter -> GLenum -- magfilter -> String -- path to image - -> FullShader' -> IO FullShader' + -> FullShader -> IO FullShader addTexture2D nlev minfilt magfilt texpath shad = do Right cmap <- readImage texpath let texdata = convertRGBA8 cmap @@ -63,7 +63,7 @@ addTexture2D nlev minfilt magfilt texpath shad = do -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- an image that was directly readable by glTexSubImage3D, used the -- transformation tilesToLine 8 128 on the underlying pixels. -addTextureArray :: String -> FullShader' -> IO FullShader' +addTextureArray :: String -> FullShader -> IO FullShader addTextureArray texturePath shad = do err <- glGetError print err @@ -87,10 +87,10 @@ tilesToLine -> [a] tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w -addUniforms :: [String] -> FullShader' -> IO FullShader' +addUniforms :: [String] -> FullShader -> IO FullShader addUniforms uniStrings shad = do foldM addUniform shad uniStrings -addUniform :: FullShader' -> String -> IO FullShader' +addUniform :: FullShader -> String -> IO FullShader addUniform shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do loc <- glGetUniformLocation (_shadProg' shad) cstr return $ shad & shadUnis' %~ (V.++ V.fromList [loc]) diff --git a/src/Shader/Bind.hs b/src/Shader/Bind.hs index be9fdf264..b2fa55a0b 100644 --- a/src/Shader/Bind.hs +++ b/src/Shader/Bind.hs @@ -27,7 +27,7 @@ bindArrayBuffers numVs theVBO = do (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) (_vboPtr theVBO) -bindShaderLayers :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> IO () +bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () bindShaderLayers shads counts = MV.imapM_ f shads where f i shad = do @@ -47,17 +47,17 @@ bindShaderLayers shads counts = MV.imapM_ f shads (fromIntegral $ floatSize * numVs * stride) (_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay)) -bindShader :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> IO () +bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () bindShader shads counts = MV.imapM_ f shads where f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO' $ shad) -bindShaderBuffers :: [FullShader'] -> [Int] -> IO () +bindShaderBuffers :: [FullShader] -> [Int] -> IO () bindShaderBuffers = zipWithM_ f where f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs -bindShaderBuffers' :: [FullShader'] -> [Int] -> IO () +bindShaderBuffers' :: [FullShader] -> [Int] -> IO () bindShaderBuffers' = zipWithM_ f where f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO' fs diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index d7c19558f..432f080f5 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -29,12 +29,12 @@ makeShader :: -- | The input vertex sizes [Int] -> EPrimitiveMode -> - IO FullShader' + IO FullShader makeShader s shaderlist sizes pm = do prog <- makeSourcedShader s shaderlist vaob <- setupVAO sizes return $ - FullShader' + FullShader { _shadProg' = prog , _shadVAO' = vaob , _shadPrim' = pm @@ -49,11 +49,11 @@ makeByteStringShaderUsingVAO :: [(GLenum, BS.ByteString)] -> EPrimitiveMode -> VAO -> - IO FullShader' + IO FullShader makeByteStringShaderUsingVAO s shaderlist pm vao = do prog <- makeShaderProgram s shaderlist return $ - FullShader' + FullShader { _shadProg' = prog , _shadVAO' = vao , _shadPrim' = pm @@ -69,11 +69,11 @@ makeShaderUsingVAO :: [GLenum] -> EPrimitiveMode -> VAO -> - IO FullShader' + IO FullShader makeShaderUsingVAO s shaderlist pm theVAO = do prog <- makeSourcedShader s shaderlist return $ - FullShader' + FullShader { _shadProg' = prog , _shadVAO' = theVAO , _shadPrim' = pm @@ -95,12 +95,12 @@ makeShaderSized :: -- | Number of vertexes that can be poked Int -> EPrimitiveMode -> - IO FullShader' + IO FullShader makeShaderSized s shaderlist sizes ndraw pm = do prog <- makeSourcedShader s shaderlist vaob <- setupVAOSized ndraw sizes return $ - FullShader' + FullShader { _shadProg' = prog , _shadVAO' = vaob , _shadPrim' = pm diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 6a23d6ffd..8687e3745 100644 --- a/src/Shader/Data.hs +++ b/src/Shader/Data.hs @@ -6,7 +6,7 @@ module Shader.Data , VBO (..) , EBO (..) -- , FullShader (..) - , FullShader' (..) + , FullShader (..) , ShaderTexture (..) , EPrimitiveMode (..) -- | Lens functions @@ -35,7 +35,7 @@ import Graphics.GL.Core43 import Foreign import Control.Lens {- | Datatype containing the necessary information for a single shader. -} -data FullShader' = FullShader' +data FullShader = FullShader { _shadProg' :: GLuint -- should be shaderID , _shadVAO' :: VAO , _shadPrim' :: EPrimitiveMode @@ -87,5 +87,5 @@ geom' = GL_GEOMETRY_SHADER frag' = GL_FRAGMENT_SHADER makeLenses ''VAO makeLenses ''VBO -makeLenses ''FullShader' +makeLenses ''FullShader makeLenses ''EBO diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 7c67a1b9f..e7bd2a324 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -25,14 +25,14 @@ import Control.Monad.Primitive --import qualified Control.Monad.Parallel as MP pokeVerxs - :: MV.MVector (PrimState IO) FullShader' + :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Picture -> IO () --pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count) . S.each pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList -pokeVerx :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do typeOff <- UMV.unsafeRead offsets sn basePtr <- _vboPtr . _vaoVBO . _shadVAO' <$> MV.unsafeRead vbos sn @@ -183,14 +183,14 @@ pokeJustV ptr nv sh = do V4 d e f g = _svCol sh pokeLayVerxs - :: MV.MVector (PrimState IO) FullShader' + :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Picture -> IO () --pokeLayVerxs vbos counts = S.mapM_ (pokeLayVerx vbos counts) . S.each pokeLayVerxs vbos counts = VFSM.mapM_ (pokeLayVerx vbos counts) . VFSM.fromList -pokeLayVerx :: MV.MVector (PrimState IO) FullShader' -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () --{-# INLINE pokeLayVerx #-} pokeLayVerx vbos counts vx = do theOff <- UMV.unsafeRead counts vecPos