Start migration to openGLraw, add target parameter to texture params

src/Data/Preload/Render.hs

@@ -44,6 +44,7 @@ data RenderData = RenderData
     , _rboBaseBloom             :: RenderbufferObject
     , _fboLighting              :: (FramebufferObject, TextureObject)
     , _fboLightingHigh          :: (FramebufferObject, TextureObject)
+    , _fboShadow                :: (FramebufferObject, (TextureObject,TextureObject))
     , _matUBO                   :: BufferObject
     }
 makeLenses ''RenderData

src/Framebuffer/Setup.hs

@@ -4,6 +4,7 @@ module Framebuffer.Setup
     ( setupTextureFramebuffer
     , setupFramebufferGivenStencil
     , setupFramebuffer2GivenStencil 
+    , setupShadowFramebuffer
     ) where
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core43
@@ -28,6 +29,16 @@ setupTextureFramebuffer x y = do
         _ -> putStrLn $ "Texture framebuffer status: " ++ show fboStatus
     return (fboName, fboTO)
 
+setupShadowFramebuffer :: IO (FramebufferObject,(TextureObject,TextureObject))
+setupShadowFramebuffer = do
+    fboName <- genObjectName
+    bindFramebuffer Framebuffer $= fboName
+    toName <- genObjectName
+    toName2 <- genObjectName
+    --textureBinding Texture2DArray $= Just toName
+    --framebufferRenderbuffer Framebuffer DepthStencilAttachment Renderbuffer rboName
+    return (fboName,(toName,toName2))
+
 setupFramebufferGivenStencil 
     :: RenderbufferObject 
     -> IO (FramebufferObject, TextureObject)

src/Framebuffer/Update.hs

@@ -30,8 +30,11 @@ sizeFBOs xsize ysize xfull yfull rdata = do
         [fboBloom, fboPos]
     rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata'' 
         [fbo2, fbo3]
-    foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata''' 
+    rdata4 <- foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata''' 
         [fboHalf1,fboHalf2,fboHalf3]
+    newShadowFBO <- resizeShadowFBO (rdata ^. fboShadow) xsize ysize
+    return $ rdata4 & fboShadow .~ newShadowFBO
+--    return rdata4
 
 resizeRBO
     :: RenderbufferObject
@@ -68,6 +71,33 @@ updateFBOTO2 xsize ysize mmfilt inFormat1 inFormat2 pdata target = do
     newfbo2 <- resizeFBOTO2 (pdata ^# target) xsize ysize mmfilt inFormat1 inFormat2
     return $ storing target newfbo2 pdata
 
+resizeShadowFBO :: (FramebufferObject, (TextureObject,TextureObject))
+    -> Int -> Int -> IO (FramebufferObject, (TextureObject,TextureObject))
+resizeShadowFBO (fboname,(oldto1,oldto2)) xsize ysize = do
+    let xsize' = fromIntegral xsize
+        ysize' = fromIntegral ysize
+    bindFramebuffer Framebuffer $= 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
+--    glFramebufferTexture GL_FRAMEBUFFER 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
+--    glFramebufferTexture GL_FRAMEBUFFER GL_DEPTH_STENCIL_ATTACHMENT (unTexture to2) 0
+--    fboStatus <- framebufferStatus Framebuffer
+--    case fboStatus of
+--        Complete -> return ()
+--        _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
+    return (fboname,(to1,to2))
+
+unTexture :: TextureObject -> GLuint
+unTexture (TextureObject t) = t
+
 resizeFBOTO2
     :: (FramebufferObject , (TextureObject,TextureObject))
     -> Int
@@ -96,7 +126,7 @@ resizeFBOTO2 (fboName,(toOld1,toOld2)) xsize ysize mmfilt inFormat1 inFormat2 =
     fboStatus <- framebufferStatus Framebuffer
     case fboStatus of
         Complete -> return ()
-        _ -> putStrLn $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
+        _ -> error $ "after resize, resizeFBOTO2 framebuffer status:" ++ show fboStatus
     return (fboName, (toName1,toName2))
 
 resizeFBOTO
@@ -119,7 +149,7 @@ resizeFBOTO (fboName,toOld) xsize ysize mmfilt inFormat = do
     fboStatus <- framebufferStatus Framebuffer
     case fboStatus of
         Complete -> return ()
-        _ -> putStrLn $ "after resize, resizeFBOTO framebuffer status:" ++ show fboStatus
+        _ -> error $ "after resize, resizeFBOTO framebuffer status:" ++ show fboStatus
     return (fboName, toName)
 
 minMagFilter :: ((TextureFilter, Maybe TextureFilter),TextureFilter)

src/Preload/Render.hs

@@ -179,6 +179,8 @@ preloadRender = do
     fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName
     fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName
 
+    fboShadowName <- setupShadowFramebuffer
+
     fboHalf1Name <- setupTextureFramebuffer 300 300
     fboHalf2Name <- setupTextureFramebuffer 300 300
     fboHalf3Name <- setupTextureFramebuffer 300 300
@@ -228,6 +230,7 @@ preloadRender = do
             , _fboHalf3 = fboHalf3Name
             , _fboLighting = fboLightingName
             , _fboLightingHigh = fboLightingHighName
+            , _fboShadow = fboShadowName
             , _fboBase = fboBaseName
             , _fboCloud = fboCloudName
             , _fboBloom = fboBloomName

src/Shader.hs

@@ -41,8 +41,10 @@ drawShader fs i = do
     currentProgram $= Just (_shadProg fs)
     bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
     case _shadTex fs of 
-        Just ShaderTexture{_textureObject = txo}
+        Just ShaderTexture{_textureObject = TextureObject txo
-            -> textureBinding Texture2D $= Just txo
+                , _textureTarget = tt }
+--            -> textureBinding Texture2D $= Just txo
+            -> glBindTexture tt txo
         _   -> return ()
     glDrawArrays 
         (marshalEPrimitiveMode $ _shadPrim fs) 

src/Shader/AuxAddition.hs

@@ -29,9 +29,13 @@ addTexture texturePath shad = do
     glTexStorage2D GL_TEXTURE_2D 3 GL_RGBA8 wtex htex
     VS.unsafeWith (imageData tex) $ \ptr -> do
         glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
-    textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
+    --textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
+    textureFilter Texture2D $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2D
-    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
+    return $ shad & shadTex ?~ ShaderTexture 
+        {_textureObject = textureOb
+        ,_textureTarget = GL_TEXTURE_2D
+        }
 
 vaddTextureNoFilter :: String -> FullShader -> IO FullShader
 vaddTextureNoFilter texturePath shad = do
@@ -45,7 +49,10 @@ vaddTextureNoFilter texturePath shad = do
     glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
     VS.unsafeWith (imageData tex) $ \ptr -> do
         glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
-    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
+    return $ shad & shadTex ?~ ShaderTexture 
+        { _textureObject = textureOb
+        , _textureTarget = GL_TEXTURE_2D
+        }
 
 addTextureNoFilter :: String -> FullShader -> IO FullShader
 addTextureNoFilter texturePath shad = do
@@ -59,7 +66,10 @@ addTextureNoFilter texturePath shad = do
     glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
     VS.unsafeWith (imageData tex) $ \ptr -> do
         glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
-    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
+    return $ shad & shadTex ?~ ShaderTexture 
+        { _textureObject = textureOb
+        , _textureTarget = GL_TEXTURE_2D
+        }
 
 -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
 -- an image that was directly readable by glTexSubImage3D, used the
@@ -81,7 +91,10 @@ addTextureArray texturePath shad = do
         glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
     textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
     generateMipmap' Texture2DArray
-    return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
+    return $ shad & shadTex ?~ ShaderTexture 
+        { _textureObject = textureOb
+        , _textureTarget = GL_TEXTURE_2D_ARRAY
+        }
 
 -- I am completely unclear on why this works with its current parameters
 tilesToLine 

src/Shader/Data.hs

@@ -60,8 +60,10 @@ data EBO = EBO
     , _eboPtr   :: Ptr GLushort
     }
 {- | Datatype containing the reference to a texture object.  -}
-newtype ShaderTexture = ShaderTexture
+data ShaderTexture = ShaderTexture
-    { _textureObject :: TextureObject }
+    { _textureObject :: TextureObject 
+    , _textureTarget :: GLenum
+    }
 data EPrimitiveMode
     = EPoints
     | ELines