diff --git a/src/Dodge/Config/Update.hs b/src/Dodge/Config/Update.hs index 939ecdac3..f202a3b9c 100644 --- a/src/Dodge/Config/Update.hs +++ b/src/Dodge/Config/Update.hs @@ -37,7 +37,7 @@ applyWorldConfig -> PreloadData SoundOrigin -> IO (PreloadData SoundOrigin) applyWorldConfig cfig pdata = do - setVol cfig pdata >>= resizeSpareFBO (x `div` divRes) (y `div` divRes) x y + setVol cfig pdata >>= sizeFBOs (x `div` divRes) (y `div` divRes) x y where x = round $ _windowX cfig y = round $ _windowY cfig diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 9dde538d7..2852bc291 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -65,7 +65,7 @@ handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World handleResizeEvent sev w = Just . set (config . windowX) (fromIntegral x) . set (config . windowY) (fromIntegral y) - $ over sideEffects ( resizeSpareFBO (x `div` divRes) (y `div` divRes) x y : ) + $ over sideEffects ( sizeFBOs (x `div` divRes) (y `div` divRes) x y : ) w where x = fromIntegral x' diff --git a/src/Dodge/Event/Menu.hs b/src/Dodge/Event/Menu.hs index f9f76c184..d7639264f 100644 --- a/src/Dodge/Event/Menu.hs +++ b/src/Dodge/Event/Menu.hs @@ -90,7 +90,7 @@ scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber updateFramebufferSize :: World -> World updateFramebufferSize w = w & sideEffects - %~ (resizeSpareFBO (x `div` divRes) (y `div` divRes) x y : ) + %~ (sizeFBOs (x `div` divRes) (y `div` divRes) x y : ) where (x,y) = (round $ getWindowX w, round $ getWindowY w) divRes = w ^. config . shadow_resolution diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index e0684248a..66fd126d8 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -1,5 +1,5 @@ --{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -Wno-unused-top-binds #-} +--{-# OPTIONS_GHC -Wno-unused-top-binds #-} module Preload.Render ( preloadRender , cleanUpRenderPreload @@ -14,8 +14,9 @@ import Shader.Parameters import Data.Preload.Render import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) +import Graphics.GL.Core43 --import Control.Lens -import Control.Monad +--import Control.Monad import Foreign preloadRender :: IO RenderData @@ -66,7 +67,8 @@ preloadRender = do eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4] ETriangles pokeEllStrat bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4] ETriangleStrip pokeBezQStrat cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] ETriangles pokeCharStrat - >>= addTexture "data/texture/charMap.png" + >>= addTextureNoFilter "data/texture/charMap.png" + -- this should really be a 2d texture array basicTweakZShad <- makeShader "twoD/basicTweakZ" [vert,frag] [4,4] ETriangles pokeTriTweakZ -- fullscreen shaders fullscreenAlphaHalveShad <- makeShader "fullscreen/alphaHalve" [vert,frag] [2] ETriangleStrip $ @@ -159,35 +161,6 @@ cornerListNoCoord = ] --------------------end preloadRender -setupFramebufferWithStencil :: IO (FramebufferObject, TextureObject,RenderbufferObject) -setupFramebufferWithStencil = do - fboName <- genObjectName - bindFramebuffer Framebuffer $= fboName - - fboTO <- genObjectName - textureBinding Texture2D $= Just fboTO - texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) - textureFilter Texture2D $= minMagFilter - framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 - - fboRBO <- genObjectName - bindRenderbuffer Renderbuffer $= fboRBO - renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) - framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer fboRBO - - fboStatus <- framebufferStatus Framebuffer - print fboStatus - - return (fboName, fboTO, fboRBO) - -setupFramebuffersSharedStencil :: Int -> IO ( [(FramebufferObject,TextureObject)] , RenderbufferObject) -setupFramebuffersSharedStencil n = do - rboName <- genObjectName - bindRenderbuffer Renderbuffer $= rboName - renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) - fbs <- replicateM n (newFramebufferGivenStencil rboName) - return (fbs,rboName) - newFramebufferGivenStencil :: RenderbufferObject -> IO (FramebufferObject, TextureObject) @@ -195,11 +168,6 @@ newFramebufferGivenStencil rboName = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName toName <- genObjectName - textureBinding Texture2D $= Just toName - texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) - -- don't need mipmaps - textureFilter Texture2D $= minMagFilter - framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0 framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName fboStatus <- framebufferStatus Framebuffer print fboStatus @@ -212,11 +180,6 @@ newFramebufferGivenStencilAlpha rboName = do fboName <- genObjectName bindFramebuffer Framebuffer $= fboName toName <- genObjectName - textureBinding Texture2D $= Just toName - texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D 800 600) 0 (PixelData RGBA UnsignedByte nullPtr) - -- don't need mipmaps - textureFilter Texture2D $= minMagFilter - framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D toName 0 framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName fboStatus <- framebufferStatus Framebuffer print fboStatus @@ -232,7 +195,7 @@ setupTextureFramebuffer x y = do fboTO <- genObjectName textureBinding Texture2D $= Just fboTO - texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D x y) 0 (PixelData RGBA UnsignedByte nullPtr) + glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 x y textureFilter Texture2D $= minMagFilter framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 fboStatus <- framebufferStatus Framebuffer @@ -298,10 +261,6 @@ pokeWPColStrat :: RenderType -> [[Float]] pokeWPColStrat Render22x4{_unRender22x4=(((x,y),(z,w)),(r,g,b,a))} = [[x,y,z,w,r,g,b,a]] pokeWPColStrat _ = undefined -poke32 :: RenderType -> [[Float]] -poke32 Render3x2{_unRender3x2=((x,y,z),(a,b))} = [[x,y,z,a,b]] -poke32 _ = undefined - poke33 :: RenderType -> [[Float]] poke33 Render3x3{_unRender3x3=((x,y,z),(a,b,c))} = [[x,y,z,a,b,c]] poke33 _ = undefined diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index 6b2a28fce..b6d70be4d 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -1,6 +1,6 @@ {-# LANGUAGE NoMonomorphismRestriction #-} module Preload.Update - ( resizeSpareFBO + ( sizeFBOs ) where import Data.Preload @@ -8,32 +8,23 @@ import Data.Preload.Render import Graphics.Rendering.OpenGL import Graphics.GL.Core43 -import Foreign +--import Foreign import Control.Lens import Control.Monad -resizeSpareFBO +sizeFBOs :: Int -- ^ Lightmap width -> Int -- ^ Lightmap height -> Int -- ^ Full width -> Int -- ^ Full height -> PreloadData a -> IO (PreloadData a) -resizeSpareFBO xsize ysize xfull yfull pdata = do --- I am unsure how much of this needs to be bound... +sizeFBOs xsize ysize xfull yfull pdata = do let rdata = _renderData pdata - --resizeFBOTO (_fbo3 rdata) xfull yfull resizeRBO (_rboBaseBloom rdata) xfull yfull - --resizeFBOTO (_fboBase rdata) xfull yfull - --resizeFBOTO (_fboBloom rdata) xfull yfull - --resizeFBOTO (_fboColor rdata) xfull yfull resizeRBO (_rboLighting rdata) xsize ysize - --resizeFBOTO (_fboLighting rdata) xsize ysize - pdata' <- foldM (resizeFBOTO'' xfull yfull) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor] - resizeFBOTO'' xsize ysize pdata' fboLighting - --foldM (resizeFBOTO'' xsize ysize) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor] - --resizeFBOTO (_fboLighting rdata) xsize ysize - --return $ pdata & renderData . fbo2 .~ newfbo2 + pdata' <- foldM (updateFBOTO xfull yfull) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor] + updateFBOTO xsize ysize pdata' fboLighting resizeRBO :: RenderbufferObject @@ -46,22 +37,22 @@ resizeRBO rboName xsize ysize = do bindRenderbuffer Renderbuffer $= rboName renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize xsize' ysize') -resizeFBOTO'' +updateFBOTO :: Int -> Int -> PreloadData a -> ALens' RenderData (FramebufferObject, TextureObject) -> IO (PreloadData a) -resizeFBOTO'' xsize ysize pdata target = do - newfbo2 <- resizeFBOTO' (pdata ^# renderData . target) xsize ysize +updateFBOTO xsize ysize pdata target = do + newfbo2 <- resizeFBOTO (pdata ^# renderData . target) xsize ysize return $ storing (renderData . target) newfbo2 pdata -resizeFBOTO' +resizeFBOTO :: (FramebufferObject , TextureObject) -> Int -> Int -> IO (FramebufferObject, TextureObject) -resizeFBOTO' (fboName,toOld) xsize ysize = do +resizeFBOTO (fboName,toOld) xsize ysize = do bindFramebuffer Framebuffer $= fboName let xsize' = fromIntegral xsize ysize' = fromIntegral ysize @@ -78,18 +69,3 @@ resizeFBOTO' (fboName,toOld) xsize ysize = do minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter) minMagFilter = ((Nearest,Nothing),Nearest) -resizeFBOTO - :: (FramebufferObject , TextureObject) - -> Int - -> Int - -> IO () -resizeFBOTO (fboName,fboTO) xsize ysize = do - let xsize' = fromIntegral xsize - ysize' = fromIntegral ysize - bindFramebuffer Framebuffer $= fboName - textureBinding Texture2D $= Just fboTO - texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D xsize' ysize') 0 (PixelData RGBA UnsignedByte nullPtr) - framebufferTexture2D Framebuffer (ColorAttachment 0) Texture2D fboTO 0 - fboStatus <- framebufferStatus Framebuffer - putStrLn $ "after resize, framebuffer status:" ++ show fboStatus - diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 70d53e81f..81bc92d14 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -1,5 +1,6 @@ module Shader.AuxAddition ( addTexture + , addTextureNoFilter , addTextureArray , addUniforms ) where @@ -26,11 +27,26 @@ addTexture texturePath shad = do let texData = V.toList $ imageData tex wtex = fromIntegral $ imageWidth tex htex = fromIntegral $ imageHeight tex + glTexStorage2D GL_TEXTURE_2D 3 GL_RGBA8 wtex htex withArray texData $ \ptr -> do - texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D wtex htex) 0 - (PixelData RGBA UnsignedByte ptr) + glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr + textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') generateMipmap' Texture2D - textureFilter Texture2D $= ((Linear',Just Linear') , Nearest) + return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} + +addTextureNoFilter :: String -> FullShader -> IO FullShader +addTextureNoFilter texturePath shad = do + Right cmap <- readImage texturePath + let tex = convertRGBA8 cmap + textureOb <- genObjectName + textureBinding Texture2D $= Just textureOb + let texData = V.toList $ imageData tex + wtex = fromIntegral $ imageWidth tex + htex = fromIntegral $ imageHeight tex + glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex + withArray texData $ \ptr -> do + glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr + textureFilter Texture2DArray $= ((Nearest,Nothing) , Nearest) return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} addTextureArray :: String -> FullShader -> IO FullShader