Refactor

src/Dodge/Render.hs

@@ -44,7 +44,6 @@ doDrawing win pdata u = do
         (wallPointsCol, windowPoints, wallSPics) = wallsToDraw w
         lightPoints = lightsToRender cfig (w ^. cWorld . camPos) (w ^. cWorld . lWorld)
         viewFroms@(V2 vfx vfy) = w ^. cWorld . camPos . camViewFrom
-        viewFrom3d = Vector3 vfx vfy 20
         shadV = _pictureShaders pdata
         lwShad = _lightingWallShadShader pdata
     -- bind as much data into vbos as feasible at this point

src/Dodge/Render/Shadow.hs

@@ -2,7 +2,7 @@ module Dodge.Render.Shadow where
 
 import Shader.Parameters
 import Shader.ExtraPrimitive
-import Graphics.Rendering.OpenGL (currentProgram, ($=), bindVertexArrayObject, bindBuffer
+import Graphics.Rendering.OpenGL ( ($=), bindVertexArrayObject, bindBuffer
     , BufferTarget (..), bufferSubData, TransferDirection (..)
     )
 import Graphics.GL.Core43

src/Shader/AuxAddition.hs

@@ -1,17 +1,11 @@
 module Shader.AuxAddition
-    ( addTexture
+    ( 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)
@@ -25,91 +19,28 @@ import Graphics.GL.Core43
     
 -- I am not sure if this assumes that the shader is constructed directly before
 -- the texture is added...
-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
-        }
-
 addTexture' :: String -> FullShader' -> IO FullShader'
-addTexture' texturePath shad = do
+addTexture' = addTexture2D 3 ((Linear',Just Linear') , Linear')
-    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
-    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
-        }
 
 vaddTextureNoFilter' :: String -> FullShader' -> IO FullShader'
-vaddTextureNoFilter' texturePath shad = do
+vaddTextureNoFilter' = addTexture2D 1 ((Nearest,Nothing), Nearest)
-    Right cmap <- readImage texturePath
+--vaddTextureNoFilter' = addTexture2D 3 ((Linear',Just Linear') , Linear')
-    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
+addTexture2D :: GLint -> ((TextureFilter,Maybe TextureFilter),TextureFilter)
-addTextureNoFilter texturePath shad = do
+    -> String -> FullShader' -> IO FullShader'
-    Right cmap <- readImage texturePath
+addTexture2D nlev filt texpath shad = do
+    Right cmap <- readImage texpath
     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
+    glTexStorage2D GL_TEXTURE_2D nlev 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 
+    textureFilter Texture2D $= filt
+    generateMipmap' Texture2D
+    return $ shad & shadTex' ?~ ShaderTexture 
         {_textureObject = textureOb
         ,_textureTarget = GL_TEXTURE_2D
         }
@@ -117,41 +48,14 @@ addTextureNoFilter texturePath 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 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
-        }
 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
@@ -168,14 +72,8 @@ tilesToLine
     -> [a]
 tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
 
-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