Move shader compilation over to raw opengl, errors display incorrect

src/Shader/AuxAddition.hs

@@ -1,13 +1,20 @@
 module Shader.AuxAddition
     ( addTexture
+    , addTexture'
     , addTextureNoFilter
     , vaddTextureNoFilter
+    , vaddTextureNoFilter'
     , addTextureArray
+    , addTextureArray'
     , addUniforms
+    , addUniforms'
     , tilesToLine -- ^ kept in case it is needed in the future
     ) where
 import Shader.Data
-
+import Foreign.Marshal
+import Control.Monad
+import qualified Data.ByteString as BS
+import Data.ByteString.Char8 (pack)
 import qualified Data.Vector as V
 import Data.List.Extra
 import Codec.Picture
@@ -37,6 +44,25 @@ addTexture texturePath shad = do
         ,_textureTarget = GL_TEXTURE_2D
         }
 
+addTexture' :: String -> FullShader' -> IO FullShader'
+addTexture' texturePath shad = do
+    Right cmap <- readImage texturePath
+    let tex = convertRGBA8 cmap
+    textureOb <- genObjectName
+    textureBinding Texture2D $= Just textureOb
+    let wtex = fromIntegral $ imageWidth  tex
+        htex = fromIntegral $ imageHeight tex
+    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 Texture2D $= ((Linear',Just Linear') , Linear')
+    generateMipmap' Texture2D
+    return $ shad & shadTex' ?~ ShaderTexture 
+        {_textureObject = textureOb
+        ,_textureTarget = GL_TEXTURE_2D
+        }
+
 vaddTextureNoFilter :: String -> FullShader -> IO FullShader
 vaddTextureNoFilter texturePath shad = do
     Right cmap <- readImage texturePath
@@ -54,6 +80,23 @@ vaddTextureNoFilter texturePath shad = do
         , _textureTarget = GL_TEXTURE_2D
         }
 
+vaddTextureNoFilter' :: String -> FullShader' -> IO FullShader'
+vaddTextureNoFilter' texturePath shad = do
+    Right cmap <- readImage texturePath
+    let tex = convertRGBA8 cmap
+    textureOb <- genObjectName
+    textureBinding Texture2D $= Just textureOb
+    textureFilter Texture2D $= ((Nearest,Nothing) , Nearest)
+    let wtex = fromIntegral $ imageWidth  tex
+        htex = fromIntegral $ imageHeight tex
+    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
+        , _textureTarget = GL_TEXTURE_2D
+        }
+
 addTextureNoFilter :: String -> FullShader -> IO FullShader
 addTextureNoFilter texturePath shad = do
     Right cmap <- readImage texturePath
@@ -95,6 +138,27 @@ addTextureArray texturePath shad = do
         { _textureObject = textureOb
         , _textureTarget = GL_TEXTURE_2D_ARRAY
         }
+addTextureArray' :: String -> FullShader' -> IO FullShader'
+addTextureArray' texturePath shad = do
+    textureOb <- genObjectName
+    textureBinding Texture2DArray $= Just textureOb
+    Right cmap <- readImage texturePath
+    let tex = convertRGBA8 cmap
+    --let texData = tilesToLine 8 128 . 
+    --let texData = tilesToLine 8 128 . 
+    --        V.toList $ imageData tex
+    glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64
+    --writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8)
+    --withArray texData $ \ptr -> do
+    VS.unsafeWith (imageData tex) $ \ptr -> do
+        --glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
+        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
+        , _textureTarget = GL_TEXTURE_2D_ARRAY
+        }
 
 -- I am completely unclear on why this works with its current parameters
 tilesToLine 
@@ -108,3 +172,14 @@ addUniforms :: [String] -> FullShader -> IO FullShader
 addUniforms uniStrings shad = do
     uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
     return $ shad & shadUnis %~ (V.++ V.fromList uniLocs)
+addUniforms' :: [String] -> FullShader' -> IO FullShader'
+addUniforms' uniStrings shad = do foldM addUniform' shad uniStrings
+--    uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
+--    return $ shad & shadUnis' %~ (V.++ V.fromList uniLocs)
+
+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])
+        
+