Remove glTexImage

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

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'

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

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

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
+sizeFBOs xsize ysize xfull yfull pdata = do
--- I am unsure how much of this needs to be bound...
     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 (updateFBOTO xfull yfull) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor]
-    pdata' <- foldM (resizeFBOTO'' xfull yfull) pdata [fbo2, fbo3, fboBase, fboBloom, fboColor]
+    updateFBOTO xsize ysize pdata' fboLighting
-    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
 
 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
+updateFBOTO xsize ysize pdata target = do
-    newfbo2 <- resizeFBOTO' (pdata ^# renderData . target) xsize ysize
+    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
-    

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 
+        glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
-                        (PixelData RGBA UnsignedByte 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