Cleanup

src/Dodge/Render.hs

@@ -110,7 +110,7 @@ doDrawing win pdata u = do
 --    uniform (_shadUnis lwShad V.! 0) $= viewFrom3d
     glUseProgram (lwShad ^. shadProg')
     glUniform3f (_shadUnis' lwShad V.! 0) vfx vfy 20
-    bindVertexArrayObject $= lwShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO lwShad)
+    bindVertexArrayObject $= lwShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO lwShad)
     unless (debugOn Remove_LOS cfig) $
         glDrawArrays
             (marshalEPrimitiveMode $ _shadPrim' lwShad)
@@ -126,7 +126,7 @@ doDrawing win pdata u = do
     let fs = _shapeShader pdata
     --currentProgram $= Just (_shadProg fs)
     glUseProgram (_shadProg' fs)
-    bindVertexArrayObject $= fs ^? shadVAO' . vao -- Just (_vao $ _shadVAO fs)
+    bindVertexArrayObject $= fs ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO fs)
     glDrawElements
         (marshalEPrimitiveMode $ _shadPrim' fs)
         (fromIntegral nIndices)

src/Dodge/Render/Shadow.hs

@@ -32,7 +32,7 @@ drawCPUShadows pdata s pos rad = do
         (theshad ^. shadVAO' . vaoVBO . vboPtr)
     --currentProgram $= theshad ^? shadProg
     glUseProgram (theshad ^. shadProg')
-    bindVertexArrayObject $= Just (_vao $ _shadVAO' theshad)
+    bindVertexArrayObject $= Just (_vaoName $ _shadVAO' theshad)
     glDrawArrays
         (marshalEPrimitiveMode $ _shadPrim' theshad) 
         0

src/Preload/Render.hs

@@ -5,6 +5,7 @@ module Preload.Render (
     cleanUpRenderPreload,
 ) where
 
+import Control.Lens
 import Control.Monad
 import Data.Preload.Render
 import qualified Data.Vector.Mutable as MV
@@ -46,8 +47,8 @@ preloadRender = do
     bindVertexArrayObject $= Just wpColVAOname
     setupVertexAttribPointer 0 4 8 0
     setupVertexAttribPointer 1 4 8 4
-    let wpVAO = VAO{_vao = wpVAOname, _vaoVBO = wpVBO}
+    let wpVAO = VAO{_vaoName = wpVAOname, _vaoVBO = wpVBO}
-        wpColVAO = VAO{_vao = wpColVAOname, _vaoVBO = wpVBO}
+        wpColVAO = VAO{_vaoName = wpColVAOname, _vaoVBO = wpVBO}
     -- setup window points VBO, VAOs and shaders
     winVBOname <- genObjectName
     winVBOptr <- mallocArray (8 * numDrawableWalls)
@@ -62,7 +63,7 @@ preloadRender = do
     bindVertexArrayObject $= Just winColVAOname
     setupVertexAttribPointer 0 4 8 0
     setupVertexAttribPointer 1 4 8 4
-    let winColVAO = VAO{_vao = winColVAOname, _vaoVBO = winVBO}
+    let winColVAO = VAO{_vaoName = winColVAOname, _vaoVBO = winVBO}
     -- setup shape geometry/cap VBO and two VAOs
     shEBOname <- genObjectName
     shEBOptr <- mallocArray numDrawableElements
@@ -93,8 +94,8 @@ preloadRender = do
     bindBuffer ArrayBuffer $= Just shVBOname
     setupVertexAttribPointer 0 3 7 0
     bindBuffer ElementArrayBuffer $= Just shEBOname
-    let shPosColVAO = VAO{_vao = shPosColVAOname, _vaoVBO = shVBO}
+    let shPosColVAO = VAO{_vaoName = shPosColVAOname, _vaoVBO = shVBO}
-        shPosVAO = VAO{_vao = shPosVAOname, _vaoVBO = shVBO}
+        shPosVAO = VAO{_vaoName = shPosVAOname, _vaoVBO = shVBO}
     --setup silhouette edge VAO
     shEdgeVAOname <- genObjectName
     bindVertexArrayObject $= Just shEdgeVAOname
@@ -111,56 +112,58 @@ preloadRender = do
            , StreamDraw
            )
     let silEBO = EBO{_ebo = silEBOname, _eboPtr = silEBOptr}
-        shEdgeVAO = VAO{_vao = shEdgeVAOname, _vaoVBO = shVBO}
+        shEdgeVAO = VAO{_vaoName = shEdgeVAOname, _vaoVBO = shVBO}
     -- lighting shaders
     lightingWallShadShad <-
-        makeShaderUsingVAO' "lighting/wallShadow" [vert', geom', frag'] EPoints wpVAO
+        makeShaderUsingVAO "lighting/wallShadow" [vert', geom', frag'] EPoints wpVAO
-            >>= addUniforms' ["lightPos"]
+            >>= addUniforms ["lightPos"]
     lightingCapShad <-
-        makeShaderUsingVAO' "lighting/cap" [vert', geom', frag'] ETriangles shPosVAO
+        makeShaderUsingVAO "lighting/cap" [vert', geom', frag'] ETriangles shPosVAO
-            >>= addUniforms' ["lightPos"]
+            >>= addUniforms ["lightPos"]
     lightingLineShadowShad <-
-        makeShaderUsingVAO' "lighting/lineShadow" [vert', geom', frag'] ELinesAdjacency shEdgeVAO
+        makeShaderUsingVAO "lighting/lineShadow" [vert', geom', frag'] ELinesAdjacency shEdgeVAO
-            >>= addUniforms' ["lightPos", "radiusUniform"]
+            >>= addUniforms ["lightPos", "radiusUniform"]
     -- positional shader
-    positionalBlankShad <- makeShader' "positional/blank" [vert', frag'] [3] ETriangles
+    positionalBlankShad <- makeShader "positional/blank" [vert', frag'] [3] ETriangles
     -- 2D draw shaders
-    bslist <- makeShader' "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles
+    bslist <- makeShader "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles
-    bslista <- makeShader' "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles
+    bslista <- makeShader "dualTwoD/basic" [vert', frag'] [3, 4] ETriangles
-    aslist <- makeShader' "dualTwoD/arc" [vert', frag'] [3, 4, 3] ETriangles
+    aslist <- makeShader "dualTwoD/arc" [vert', frag'] [3, 4, 3] ETriangles
-    eslist <- makeShader' "dualTwoD/ellipse" [vert', geom', frag'] [3, 4] ETriangles
+    eslist <- makeShader "dualTwoD/ellipse" [vert', geom', frag'] [3, 4] ETriangles
-    bezierQuadShader <- makeShader' "dualTwoD/bezierQuad" [vert', frag'] [3, 4, 4] ETriangleStrip
+    bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert', frag'] [3, 4, 4] ETriangleStrip
     cslist <-
-        makeShader' "dualTwoD/character" [vert', frag'] [3, 4, 2] ETriangles
+        makeShader "dualTwoD/character" [vert', frag'] [3, 4, 2] ETriangles
-            >>= vaddTextureNoFilter' "data/texture/charMap.png"
+            >>= vaddTextureNoFilter "data/texture/charMap.png"
     -- this should really be a 2d texture array
-    basicTweakZShad <- makeShader' "dualTwoD/basicTweakZ" [vert', frag'] [4, 4] ETriangles
+    basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert', frag'] [4, 4] ETriangles
     -- fullscreen shaders
     --fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip
     --pokeArray (shadVBOptr fullscreenAlphaHalveShad) $ concat cornerListNoCoord
     -- texture shaders, no textures attached
-    fsShad <- makeShaderSized' "texture/simple" [vert', frag'] [2, 2] 4 ETriangleStrip
+    fsShad <- makeShaderSized "texture/simple" [vert', frag'] [2, 2] 4 ETriangleStrip
     -- note we directly poke the shader vertex data here
     -- could possibly use an indirect draw call
     pokeArray (shadVBOptr' fsShad) $ concat cornerList
 
-    bloomBlurShad <- makeShaderUsingShaderVAO' "texture/bloomBlur" [vert', frag'] ETriangleStrip fsShad
+    let fsshadvao = fsShad ^. shadVAO'
-    colorBlurShad <- makeShaderUsingShaderVAO' "texture/colorBlur" [vert', frag'] ETriangleStrip fsShad
+
-    grayscaleShad <- makeShaderUsingShaderVAO' "texture/grayscale" [vert', frag'] ETriangleStrip fsShad
+    bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert', frag'] ETriangleStrip fsshadvao
+    colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert', frag'] ETriangleStrip fsshadvao
+    grayscaleShad <- makeShaderUsingVAO "texture/grayscale" [vert', frag'] ETriangleStrip fsshadvao
     lightingTextureShad <-
-        makeShaderUsingShaderVAO' "lighting/texture" [vert', frag'] ETriangleStrip fsShad
+        makeShaderUsingVAO "lighting/texture" [vert', frag'] ETriangleStrip fsshadvao
-            >>= addUniforms' ["lightPos", "lumRad"]
+            >>= addUniforms ["lightPos", "lumRad"]
-    barrelShad <- makeShader' "texture/barrel" [vert', geom', frag'] [2, 2, 2, 1] EPoints
+    barrelShad <- makeShader "texture/barrel" [vert', geom', frag'] [2, 2, 2, 1] EPoints
     -- blank wallShader
-    wallBlankShad <- makeShaderUsingVAO' "wall/blank" [vert', geom', frag'] EPoints wpColVAO
+    wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert', geom', frag'] EPoints wpColVAO
     -- textured wallShader
     wallTextureShad <-
-        makeShaderUsingVAO' "wall/texture" [vert', geom', frag'] EPoints wpColVAO
+        makeShaderUsingVAO "wall/texture" [vert', geom', frag'] EPoints wpColVAO
-            >>= addTexture' "data/texture/grayscaleDirt.png"
+            >>= addTexture "data/texture/grayscaleDirt.png"
     ---- texture array shader
     textArrayShad <-
-        makeShader' "texture/arrayPos" [vert', frag'] [3, 3] ETriangles
+        makeShader "texture/arrayPos" [vert', frag'] [3, 3] ETriangles
-            >>= addTextureArray' "data/texture/ayene_wooden_floor_transformed.png"
+            >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png"
     --  >>= addTextureArray "data/texture/ayene_wooden_floor.png"
     -- bind fixed vertex data
     bindShaderBuffers' [fsShad] [4, 4]

src/Preload/Update.hs

@@ -1,41 +1,56 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Preload.Update
+
-    ( pdataResizeUpdate
+module Preload.Update (
-    ) where
+    pdataResizeUpdate,
+) where
+
+import Control.Lens
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
 import Data.Preload
+import Data.Preload.Render
 import Framebuffer.Update
 import Shader.Compile
 import Shader.Data
-import Data.Preload.Render
 
-import qualified Data.ByteString as BS
+pdataResizeUpdate ::
-import qualified Data.ByteString.Char8 as BSC
+    -- | Scaled width
-pdataResizeUpdate
+    Int ->
-    :: Int  -- ^ Scaled width
+    -- | Scaled height
-    -> Int  -- ^ Scaled height
+    Int ->
-    -> Int  -- ^ Full width
+    -- | Full width
-    -> Int  -- ^ Full height
+    Int ->
-    -> PreloadData
+    -- | Full height
-    -> IO PreloadData
+    Int ->
+    PreloadData ->
+    IO PreloadData
 pdataResizeUpdate xsize ysize xfull yfull pdata = do
     rd <- renderDataResizeUpdate xsize ysize xfull yfull (_renderData pdata)
-    return (pdata {_renderData = rd})
+    return (pdata{_renderData = rd})
 
-renderDataResizeUpdate
+renderDataResizeUpdate ::
-    :: Int  -- ^ Scaled width
+    -- | Scaled width
-    -> Int  -- ^ Scaled height
+    Int ->
-    -> Int  -- ^ Full width
+    -- | Scaled height
-    -> Int  -- ^ Full height
+    Int ->
-    -> RenderData
+    -- | Full width
-    -> IO RenderData
+    Int ->
+    -- | Full height
+    Int ->
+    RenderData ->
+    IO RenderData
 renderDataResizeUpdate xsize ysize xfull yfull rdata = do
     rdata' <- sizeFBOs xsize ysize xfull yfull rdata
     bbVert <- BS.readFile "shader/texture/bloomBlur.vert"
     bbFrag <- BS.readFile "shader/texture/bloomBlur.frag"
-    let (bh,bmid) = BS.breakSubstring "(" bbFrag
+    let (bh, bmid) = BS.breakSubstring "(" bbFrag
-        (_,btt) = BS.breakSubstring ")" bmid
+        (_, btt) = BS.breakSubstring ")" bmid
         bbFrag' = BS.append bh $ BS.append (BSC.pack $ '(' : show xsize ++ "," ++ show ysize) btt
     --BSC.putStrLn bbFrag'
-    bbShad <- makeByteStringShaderUsingVAO' "bloomBlur" [(vert',bbVert),(frag',bbFrag')] ETriangleStrip
+    bbShad <-
-                (_fullscreenShader rdata)
+        makeByteStringShaderUsingVAO
-    return (rdata' {_bloomBlurShader = bbShad})
+            "bloomBlur"
+            [(vert', bbVert), (frag', bbFrag')]
+            ETriangleStrip
+            (rdata ^. fullscreenShader . shadVAO')
+    return (rdata'{_bloomBlurShader = bbShad})

src/Render.hs

@@ -81,7 +81,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
         --uniform (_shadUnis lwallShad V.! 0)
         --    $= Vector3 x y z
         glUniform3f (_shadUnis' lwallShad V.! 0) x y z
-        bindVertexArrayObject $= lwallShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO lwallShad)
+        bindVertexArrayObject $= lwallShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO lwallShad)
         glDrawArrays
             (marshalEPrimitiveMode $ _shadPrim' lwallShad)
             0
@@ -95,7 +95,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
                 glUseProgram (_shadProg' llinesShad)
                 glUniform3f (_shadUnis' llinesShad V.! 0) x y z
                 glUniform1f (_shadUnis' llinesShad V.! 1) rad
-                bindVertexArrayObject $= Just (_vao $ _shadVAO' llinesShad)
+                bindVertexArrayObject $= Just (_vaoName $ _shadVAO' llinesShad)
                 glDrawElements
                     (marshalEPrimitiveMode $ _shadPrim' llinesShad)
                     (fromIntegral nSils)
@@ -107,7 +107,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
                 --uniform (_shadUnis lcapShad V.! 0) $= Vector3 x y z
                 glUseProgram (_shadProg' lcapShad)
                 glUniform3f (_shadUnis' lcapShad V.! 0) x y z
-                bindVertexArrayObject $= lcapShad ^? shadVAO' . vao --Just (_vao $ _shadVAO lcapShad)
+                bindVertexArrayObject $= lcapShad ^? shadVAO' . vaoName --Just (_vao $ _shadVAO lcapShad)
                 glDrawElements
                     (marshalEPrimitiveMode $ _shadPrim' lcapShad)
                     (fromIntegral nCaps)
@@ -128,7 +128,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
         glUseProgram (ltextShad ^. shadProg') --Just (_shadProg ltextShad)
         glUniform3f (_shadUnis' ltextShad V.! 0) x y z
         glUniform4f (_shadUnis' ltextShad V.! 1) r g b rad
-        bindVertexArrayObject $= ltextShad ^? shadVAO' . vao -- Just (_vao $ _shadVAO ltextShad)
+        bindVertexArrayObject $= ltextShad ^? shadVAO' . vaoName -- Just (_vao $ _shadVAO ltextShad)
         glDrawArrays
             (marshalEPrimitiveMode (_shadPrim' ltextShad))
             0

src/Shader.hs

@@ -28,7 +28,7 @@ drawShaderLay l countsVector shadIn fs = do
     i <- UMV.read countsVector shadIn
     --currentProgram $= Just (_shadProg' fs)
     glUseProgram (_shadProg' fs)
-    bindVertexArrayObject $= Just (_vao $ _shadVAO' fs)
+    bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs)
     case _shadTex' fs of 
         Just ShaderTexture{_textureObject = txo} --, _textureTarget = tt}
             -- -> textureBinding Texture2D $= Just txo
@@ -45,7 +45,7 @@ drawShader :: FullShader' -> Int -> IO ()
 drawShader fs i = do 
     --currentProgram $= Just (_shadProg fs)
     glUseProgram (_shadProg' fs)
-    bindVertexArrayObject $= Just (_vao $ _shadVAO' fs)
+    bindVertexArrayObject $= Just (_vaoName $ _shadVAO' fs)
     case _shadTex' fs of 
         Just ShaderTexture{_textureObject = txo
                 } --, _textureTarget = tt }

src/Shader/AuxAddition.hs

@@ -1,8 +1,8 @@
 module Shader.AuxAddition
-    ( addTexture'
+    ( addTexture
-    , vaddTextureNoFilter'
+    , vaddTextureNoFilter
-    , addTextureArray'
+    , addTextureArray
-    , addUniforms'
+    , addUniforms
     , tilesToLine -- ^ kept in case it is needed in the future
     ) where
 import Unsafe.Coerce
@@ -17,23 +17,23 @@ import Data.List.Extra
 import Codec.Picture
 import qualified Data.Vector.Storable as VS
 import Control.Lens
-import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
+--import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core45
     
 -- I am not sure if this assumes that the shader is constructed directly before
 -- the texture is added...
-addTexture' :: String -> FullShader' -> IO FullShader'
+addTexture :: String -> FullShader' -> IO FullShader'
-addTexture' = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
+addTexture = addTexture2D 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
 
-vaddTextureNoFilter' :: String -> FullShader' -> IO FullShader'
+vaddTextureNoFilter :: String -> FullShader' -> IO FullShader'
-vaddTextureNoFilter' = addTexture2D 1 GL_NEAREST GL_NEAREST
+vaddTextureNoFilter = addTexture2D 1 GL_NEAREST GL_NEAREST
---vaddTextureNoFilter' = addTexture2D 3 ((Linear',Just Linear') , Linear')
 
-addTexture2D :: GLint -- number mipmap levels
+addTexture2D 
---    -> ((TextureFilter,Maybe TextureFilter),TextureFilter)
+    :: GLint -- number of mipmap levels
     -> GLenum -- minfilter
     -> GLenum -- magfilter
-    -> String -> FullShader' -> IO FullShader'
+    -> String -- path to image
+    -> FullShader' -> IO FullShader'
 addTexture2D nlev minfilt magfilt texpath shad = do
     Right cmap <- readImage texpath
     let texdata = convertRGBA8 cmap
@@ -54,8 +54,8 @@ addTexture2D nlev minfilt magfilt texpath 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 :: String -> FullShader' -> IO FullShader'
-addTextureArray' texturePath shad = do
+addTextureArray texturePath shad = do
     err <- glGetError
     print err
     Right cmap <- readImage texturePath
@@ -80,12 +80,10 @@ tilesToLine
     -> [a]
 tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
 
-addUniforms' :: [String] -> FullShader' -> IO FullShader'
+addUniforms :: [String] -> FullShader' -> IO FullShader'
-addUniforms' uniStrings shad = do foldM addUniform' shad uniStrings
+addUniforms uniStrings shad = do foldM addUniform shad uniStrings
 
-addUniform' :: FullShader' -> String -> IO FullShader'
+addUniform :: FullShader' -> String -> IO FullShader'
-addUniform' shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do
+addUniform shad unistr = BS.useAsCString (pack unistr) $ \cstr -> do
     loc <- glGetUniformLocation (_shadProg' shad) cstr
     return $ shad & shadUnis' %~ (V.++ V.fromList [loc])
-        
-    

src/Shader/Compile.hs

@@ -1,252 +1,127 @@
-module Shader.Compile
+module Shader.Compile (
-    ( makeShader
+    makeShader,
-    , makeShader'
+    makeByteStringShaderUsingVAO,
-    , makeByteStringShader
+    makeShaderSized,
-    , makeByteStringShader'
+--    makeShaderUsingShaderVAO,
-    , makeByteStringShaderUsingVAO
+    makeShaderUsingVAO,
-    , makeByteStringShaderUsingVAO'
+    setupVAO,
-    , makeShaderSized
+    setupVertexAttribPointer,
-    , makeShaderSized'
+) where
-    , makeShaderUsingShaderVAO
+
-    , makeShaderUsingShaderVAO'
+import Control.Monad
-    , makeShaderUsingVAO
+import qualified Data.ByteString as BS
-    , makeShaderUsingVAO'
+import qualified Data.ByteString.Unsafe as BU
-    , makeSourcedShader
+import Foreign
-    , setupVAO
+import Foreign.C.String
-    , setupVertexAttribPointer 
+--import Control.Lens
-    ) where
+
+import Graphics.GL.Core45
+import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
 import Shader.Data
 import Shader.Parameters
 
-import Foreign
+{- |
-import Foreign.C.String
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Unsafe as BU
-import Control.Monad
---import Control.Lens
-import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
-import Graphics.GL.Core43
-{- | 
 Compiles a full shader found within the shader directory.
 The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
 -}
-makeShader 
+makeShader ::
-    :: String       -- ^ First part of the name of the shader
+    -- | First part of the name of the shader
-    -> [ShaderType] -- ^ Filetype extensions
+    String ->
-    -> [Int]   -- ^ The input vertex sizes
+    -- | shader types
-    -> EPrimitiveMode 
+    [GLenum] ->
-    -> IO FullShader
+    -- | The input vertex sizes
+    [Int] ->
+    EPrimitiveMode ->
+    IO FullShader'
 makeShader s shaderlist sizes pm = do
     prog <- makeSourcedShader s shaderlist
     vaob <- setupVAO sizes
-    return $ FullShader 
+    return $
-        { _shadProg = prog
+        FullShader'
-        , _shadVAO  = vaob
+            { _shadProg' = prog
-        , _shadPrim = pm
+            , _shadVAO' = vaob
-        , _shadTex  = Nothing
+            , _shadPrim' = pm
-        , _shadUnis = mempty
+            , _shadTex' = Nothing
-        }
+            , _shadUnis' = mempty
-makeShader' 
+            }
-    :: String       -- ^ First part of the name of the shader
-    -> [GLenum] -- ^ shader types
-    -> [Int]   -- ^ The input vertex sizes
-    -> EPrimitiveMode 
-    -> IO FullShader'
-makeShader' s shaderlist sizes pm = do
-    prog <- makeSourcedShader' s shaderlist
-    vaob <- setupVAO sizes
-    return $ FullShader'
-        { _shadProg' = prog
-        , _shadVAO'  = vaob
-        , _shadPrim' = pm
-        , _shadTex'  = Nothing
-        , _shadUnis' = mempty
-        }
 
-makeByteStringShader'
+makeByteStringShaderUsingVAO ::
-    :: String       -- ^ (Arbitrary) name of the shader
+    -- | (Arbitrary) name of the shader
-    -> [(GLenum,BS.ByteString)] -- ^ Filetype extensions and shader data
+    String ->
-    -> [Int]        -- ^ The input vertex sizes
+    -- | Filetype extensions and shader data
-    -> EPrimitiveMode 
+    [(GLenum, BS.ByteString)] ->
-    -> IO FullShader'
+    EPrimitiveMode ->
-makeByteStringShader' s shaderlist sizes pm = do
+    VAO ->
-    prog <- makeShaderProgram' s shaderlist
+    IO FullShader'
-    vaob <- setupVAO sizes
+makeByteStringShaderUsingVAO s shaderlist pm vao = do
-    return $ FullShader' 
-        { _shadProg' = prog
-        , _shadVAO'  = vaob
-        , _shadPrim' = pm
-        , _shadTex'  = Nothing
-        , _shadUnis' = mempty
-        }
-
-makeByteStringShader
-    :: String       -- ^ (Arbitrary) name of the shader
-    -> [(ShaderType,BS.ByteString)] -- ^ Filetype extensions and shader data
-    -> [Int]        -- ^ The input vertex sizes
-    -> EPrimitiveMode 
-    -> IO FullShader
-makeByteStringShader s shaderlist sizes pm = do
     prog <- makeShaderProgram s shaderlist
-    vaob <- setupVAO sizes
+    return $
-    return $ FullShader 
+        FullShader'
-        { _shadProg = prog
+            { _shadProg' = prog
-        , _shadVAO  = vaob
+            , _shadVAO' = vao
-        , _shadPrim = pm
+            , _shadPrim' = pm
-        , _shadTex  = Nothing
+            , _shadTex' = Nothing
-        , _shadUnis = mempty
+            , _shadUnis' = mempty
-        }
+            }
-makeByteStringShaderUsingVAO
-    :: String       -- ^ (Arbitrary) name of the shader
-    -> [(ShaderType,BS.ByteString)] -- ^ Filetype extensions and shader data
-    -> EPrimitiveMode 
-    -> FullShader
-    -> IO FullShader
-makeByteStringShaderUsingVAO s shaderlist pm fs = do
-    prog <- makeShaderProgram s shaderlist
-    return $ fs 
-        { _shadProg = prog
-        , _shadPrim = pm
-        , _shadTex  = Nothing
-        , _shadUnis = mempty
-        }
-
-makeByteStringShaderUsingVAO'
-    :: String       -- ^ (Arbitrary) name of the shader
-    -> [(GLenum,BS.ByteString)] -- ^ Filetype extensions and shader data
-    -> EPrimitiveMode 
-    -> FullShader'
-    -> IO FullShader'
-makeByteStringShaderUsingVAO' s shaderlist pm fs = do
-    prog <- makeShaderProgram' s shaderlist
-    return $ fs 
-        { _shadProg' = prog
-        , _shadPrim' = pm
-        , _shadTex'  = Nothing
-        , _shadUnis' = mempty
-        }
 
 -- | Takes the VAO from elsewhere
-makeShaderUsingVAO
+makeShaderUsingVAO ::
-    :: String       -- ^ First part of the name of the shader
+    -- | First part of the name of the shader
-    -> [ShaderType] -- ^ Filetype extensions
+    String ->
-    -> EPrimitiveMode
+    -- | shader types
-    -> VAO
+    [GLenum] ->
-    -> IO FullShader
+    EPrimitiveMode ->
+    VAO ->
+    IO FullShader'
 makeShaderUsingVAO s shaderlist pm theVAO = do
     prog <- makeSourcedShader s shaderlist
-    return $ FullShader 
+    return $
-        { _shadProg = prog
+        FullShader'
-        , _shadVAO = theVAO
+            { _shadProg' = prog
-        , _shadPrim = pm
+            , _shadVAO' = theVAO
-        , _shadTex  = Nothing
+            , _shadPrim' = pm
-        , _shadUnis = mempty
+            , _shadTex' = Nothing
-        }
+            , _shadUnis' = mempty
-makeShaderUsingVAO'
+            }
-    :: String       -- ^ First part of the name of the shader
-    -> [GLenum] -- ^ shader types
-    -> EPrimitiveMode
-    -> VAO
-    -> IO FullShader'
-makeShaderUsingVAO' s shaderlist pm theVAO = do
-    prog <- makeSourcedShader' s shaderlist
-    return $ FullShader' 
-        { _shadProg' = prog
-        , _shadVAO' = theVAO
-        , _shadPrim' = pm
-        , _shadTex'  = Nothing
-        , _shadUnis' = mempty
-        }
 
--- | Takes the VAO from another shader
+{- |
-makeShaderUsingShaderVAO
-    :: String       -- ^ First part of the name of the shader
-    -> [ShaderType] -- ^ Filetype extensions
-    -> EPrimitiveMode
-    -> FullShader
-    -> IO FullShader
-makeShaderUsingShaderVAO s shaderlist pm fs = do
-    prog <- makeSourcedShader s shaderlist
-    return $ fs 
-        { _shadProg = prog
-        , _shadPrim = pm
-        , _shadTex  = Nothing
-        , _shadUnis = mempty
-        }
-makeShaderUsingShaderVAO'
-    :: String       -- ^ First part of the name of the shader
-    -> [GLenum]     -- ^ shader types
-    -> EPrimitiveMode
-    -> FullShader'
-    -> IO FullShader'
-makeShaderUsingShaderVAO' s shaderlist pm fs = do
-    prog <- makeSourcedShader' s shaderlist
-    return $ fs 
-        { _shadProg' = prog
-        , _shadPrim' = pm
-        , _shadTex'  = Nothing
-        , _shadUnis' = mempty
-        }
-{- | 
 Compiles a full shader found within the shader directory.
 The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
 -}
-makeShaderSized
+makeShaderSized ::
-    :: String       -- ^ First part of the name of the shader
+    -- | First part of the name of the shader
-    -> [ShaderType] -- ^ Filetype extensions
+    String ->
-    -> [Int]   -- ^ The input vertex sizes
+    -- | shader types
-    -> Int          -- ^ Number of vertexes that can be poked
+    [GLenum] ->
-    -> EPrimitiveMode
+    -- | The input vertex sizes
-    -> IO FullShader
+    [Int] ->
+    -- | Number of vertexes that can be poked
+    Int ->
+    EPrimitiveMode ->
+    IO FullShader'
 makeShaderSized s shaderlist sizes ndraw pm = do
     prog <- makeSourcedShader s shaderlist
     vaob <- setupVAOSized sizes ndraw
-    return $ FullShader 
+    return $
-        { _shadProg = prog
+        FullShader'
-        , _shadVAO  = vaob
+            { _shadProg' = prog
-        , _shadPrim = pm
+            , _shadVAO' = vaob
-        , _shadTex  = Nothing
+            , _shadPrim' = pm
-        , _shadUnis = mempty
+            , _shadTex' = Nothing
-        }
+            , _shadUnis' = mempty
-makeShaderSized'
+            }
-    :: String       -- ^ First part of the name of the shader
-    -> [GLenum] -- ^ shader types
-    -> [Int]   -- ^ The input vertex sizes
-    -> Int          -- ^ Number of vertexes that can be poked
-    -> EPrimitiveMode
-    -> IO FullShader'
-makeShaderSized' s shaderlist sizes ndraw pm = do
-    prog <- makeSourcedShader' s shaderlist
-    vaob <- setupVAOSized sizes ndraw
-    return $ FullShader' 
-        { _shadProg' = prog
-        , _shadVAO'  = vaob
-        , _shadPrim' = pm
-        , _shadTex'  = Nothing
-        , _shadUnis' = mempty
-        }
 
--- | Compile shader and get its uniform locations.
+{- | Compile shader and get its uniform locations.
--- supposes the shader code is in the shader folder, with the string names
+ supposes the shader code is in the shader folder, with the string names
--- followed by .vert/.geom/.frag.
+ followed by .vert/.geom/.frag.
-makeSourcedShader :: String -> [ShaderType] -> IO Program
+-}
+makeSourcedShader :: String -> [GLenum] -> IO GLuint
 makeSourcedShader s sts = do
-    sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
+    sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt' st)
     makeShaderProgram s $ zip sts sources
 
-makeSourcedShader' :: String -> [GLenum] -> IO GLuint
-makeSourcedShader' s sts = do
-    sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt' st)
-    makeShaderProgram' s $ zip sts sources
-
-shaderTypeExt :: ShaderType -> String
-shaderTypeExt VertexShader   = ".vert"
-shaderTypeExt GeometryShader = ".geom"
-shaderTypeExt FragmentShader = ".frag"
-shaderTypeExt _ = undefined
-
 shaderTypeExt' :: GLenum -> String
-shaderTypeExt' GL_VERTEX_SHADER   = ".vert"
+shaderTypeExt' GL_VERTEX_SHADER = ".vert"
 shaderTypeExt' GL_GEOMETRY_SHADER = ".geom"
 shaderTypeExt' GL_FRAGMENT_SHADER = ".frag"
 shaderTypeExt' _ = undefined
@@ -257,39 +132,43 @@ setupVAO sizes = do
     theVAO <- genObjectName
     bindVertexArrayObject $= Just theVAO
     theVBO <- setupVBO sizes
-    return $ VAO 
+    return $
-        { _vao = theVAO
+        VAO
-        , _vaoVBO = theVBO
+            { _vaoName = theVAO
-        }
+            , _vaoVBO = theVBO
+            }
+
 setupVAOSized :: [Int] -> Int -> IO VAO
 setupVAOSized sizes ndraw = do
     theVAO <- genObjectName
     bindVertexArrayObject $= Just theVAO
     theVBO <- setupVBOSized sizes ndraw
-    return $ VAO 
+    return $
-        { _vao = theVAO
+        VAO
-        , _vaoVBO = theVBO
+            { _vaoName = theVAO
-        }
+            , _vaoVBO = theVBO
+            }
 
 setupVBO :: [Int] -> IO VBO
 setupVBO sizes = do
     vboName <- genObjectName
     bindBuffer ArrayBuffer $= Just vboName
-    forM_ (zip3 [0..] sizes offs) $ \(loc,siz,off) -> do
+    forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
         setupVertexAttribPointer loc siz strd off
     thePtr <- mallocArray (strd * numDrawableElements)
     -- Allocate space
-    bufferData ArrayBuffer $=
+    bufferData ArrayBuffer
-        (fromIntegral $ floatSize * numDrawableElements * strd
+        $= ( fromIntegral $ floatSize * numDrawableElements * strd
-        , nullPtr
+           , nullPtr
-        , StreamDraw
+           , StreamDraw
-        )
+           )
-    return $ VBO
+    return $
-        { _vbo = vboName
+        VBO
-        , _vboPtr = thePtr
+            { _vbo = vboName
-        , _vboAttribSizes = sizes
+            , _vboPtr = thePtr
-        , _vboStride = sum sizes
+            , _vboAttribSizes = sizes
-        }
+            , _vboStride = sum sizes
+            }
   where
     strd = sum sizes
     offs = scanl (+) 0 sizes
@@ -298,108 +177,89 @@ setupVBOSized :: [Int] -> Int -> IO VBO
 setupVBOSized sizes ndraw = do
     vboName <- genObjectName
     bindBuffer ArrayBuffer $= Just vboName
-    forM_ (zip3 [0..] sizes offs) $ \(loc,siz,off) -> do
+    forM_ (zip3 [0 ..] sizes offs) $ \(loc, siz, off) -> do
         setupVertexAttribPointer loc siz strd off
     thePtr <- mallocArray (strd * ndraw)
     -- Allocate space
-    bufferData ArrayBuffer $=
+    bufferData ArrayBuffer
-        (fromIntegral $ floatSize * ndraw * strd
+        $= ( fromIntegral $ floatSize * ndraw * strd
-        , nullPtr
+           , nullPtr
-        , StreamDraw
+           , StreamDraw
-        )
+           )
-    return $ VBO
+    return $
-        { _vbo = vboName
+        VBO
-        , _vboPtr = thePtr
+            { _vbo = vboName
-        , _vboAttribSizes = sizes
+            , _vboPtr = thePtr
-        , _vboStride = sum sizes
+            , _vboAttribSizes = sizes
-        }
+            , _vboStride = sum sizes
+            }
   where
     strd = sum sizes
     offs = scanl (+) 0 sizes
-    
+
-{- | Assumes the correct VBO is bound -}
+-- | Assumes the correct VBO is bound
-setupVertexAttribPointer 
+setupVertexAttribPointer ::
-    :: Int  -- ^ Atrib location
+    -- | Atrib location
-    -> Int  -- ^ Size
+    Int ->
-    -> Int  -- ^ Stride 
+    -- | Size
-    -> Int  -- ^ Offset
+    Int ->
-    -> IO ()
+    -- | Stride
+    Int ->
+    -- | Offset
+    Int ->
+    IO ()
 setupVertexAttribPointer loc siz strd off = do
-    vertexAttribPointer (AttribLocation (fi loc)) $=
+    vertexAttribPointer (AttribLocation (fi loc))
-        (ToFloat, VertexArrayDescriptor (fi' siz) Float (fi'' $ floatSize * strd) (bufferOffset off))
+        $= (ToFloat, VertexArrayDescriptor (fi' siz) Float (fi'' $ floatSize * strd) (bufferOffset off))
     vertexAttribArray (AttribLocation (fi loc)) $= Enabled
   where
     fi = fromIntegral
     fi' = fromIntegral
     fi'' = fromIntegral
 
-makeShaderProgram' :: String 
+makeShaderProgram ::
-    -> [(GLenum,BS.ByteString)] -- list of shaders
+    String ->
-    -> IO GLuint
+    [(GLenum, BS.ByteString)] -> -- list of shaders
-makeShaderProgram' str srcs = do
+    IO GLuint
+makeShaderProgram str srcs = do
     theprog <- glCreateProgram
-    shaders <- mapM (compileAndCheckShader' str) srcs
+    shaders <- mapM (compileAndCheckShader str) srcs
     mapM_ (glAttachShader theprog) shaders
     glLinkProgram theprog
     glCheckError (str ++ " linking ") glGetProgramiv glGetProgramInfoLog theprog GL_LINK_STATUS
     mapM_ (glDetachShader theprog) shaders
     mapM_ glDeleteShader shaders
     return theprog
-    
+
-glCheckError :: (Storable t1) =>
+glCheckError ::
-                [Char]
+    (Storable t1) =>
-                -> (t2 -> GLenum -> Ptr t1 -> IO ())
+    [Char] ->
-                -> (t2 -> t1 -> Ptr a3 -> CString -> IO ())
+    (t2 -> GLenum -> Ptr t1 -> IO ()) ->
-                -> t2
+    (t2 -> t1 -> Ptr a3 -> CString -> IO ()) ->
-                -> GLenum
+    t2 ->
-                -> IO ()
+    GLenum ->
+    IO ()
 glCheckError str f g x statustype =
     alloca $ \statusPtr -> do
         f x statustype statusPtr
         status <- peek $ castPtr statusPtr
-        if status == GL_FALSE
+        when (status == GL_FALSE) $
-            then do
+            alloca $ \ptr -> do
-                alloca $ \ptr -> do
+                f x GL_INFO_LOG_LENGTH ptr
-                    f x GL_INFO_LOG_LENGTH ptr
+                len <- peek ptr -- we may have to use this length more intelligently
-                    len <- peek ptr -- we may have to use this length more intelligently
+                alloca $ \charPtr -> do
-                    alloca $ \charPtr -> do
+                    g x len nullPtr charPtr
-                        g x len nullPtr charPtr
+                    char <- peekCString charPtr
-                        char <- peekCString charPtr
+                    error $ str ++ show char
-                        error $ str ++ show char
-            else return ()
 
-makeShaderProgram :: String -> [(ShaderType,BS.ByteString)] -> IO Program
+compileAndCheckShader :: String -> (GLenum, BS.ByteString) -> IO GLuint
-makeShaderProgram str sources = do
+compileAndCheckShader str (theShaderType, sourceCode) = do
-    theShaderProgram <- createProgram
-    shaders <- mapM (compileAndCheckShader str) sources
-    mapM_ (attachShader theShaderProgram) shaders
-
-    linkProgram theShaderProgram
-    linkingSuccess <- linkStatus theShaderProgram
-    unless linkingSuccess $ do
-        infoLog <- get (programInfoLog theShaderProgram)
-        putStrLn $ str ++ ": Program Linking" ++ infoLog
-    return theShaderProgram
-
-compileAndCheckShader :: String -> (ShaderType,BS.ByteString) -> IO Shader
-compileAndCheckShader str (theShaderType,sourceCode) = do
-    theShader <- createShader theShaderType
-    shaderSourceBS theShader $= sourceCode
-    compileShader theShader
-    success <- compileStatus theShader
-    unless success $ do
-        infoLog <- get (shaderInfoLog theShader)
-        putStrLn $ str ++ ": Shader compile: " ++ show theShaderType ++ " :\n" ++ infoLog
-    return theShader
-
-compileAndCheckShader' :: String -> (GLenum,BS.ByteString) -> IO GLuint
-compileAndCheckShader' str (theShaderType,sourceCode) = do
     theShader <- glCreateShader theShaderType
     setShaderSource theShader sourceCode
     glCompileShader theShader
     glCheckError (str ++ shaderTypeExt' theShaderType) glGetShaderiv glGetShaderInfoLog theShader GL_COMPILE_STATUS
     return theShader
-            
+
 setShaderSource :: GLuint -> BS.ByteString -> IO ()
 setShaderSource si src =
     withByteString src $ \srcPtr srcLength ->
@@ -409,7 +269,7 @@ setShaderSource si src =
 
 -- https://hackage.haskell.org/package/OpenGL-3.0.3.0/docs/src/Graphics.Rendering.OpenGL.GL.ByteString.html#withByteStringP
 withByteString :: Num t => BS.ByteString -> (Ptr b -> t -> IO a) -> IO a
-withByteString bs act = 
+withByteString bs act =
     BU.unsafeUseAsCStringLen bs $ \(ptr, size) ->
         act (castPtr ptr) (fromIntegral size)
 

src/Shader/Data.hs

@@ -10,7 +10,7 @@ module Shader.Data
     , ShaderTexture (..)
     , EPrimitiveMode (..)
 -- | Lens functions
-    , vao
+    , vaoName
     , vaoVBO
     , shadProg
     , shadVAO
@@ -60,7 +60,7 @@ data FullShader' = FullShader'
 {- | Vertex array object: contains the reference to the object,
 and its buffer targets.  -}
 data VAO = VAO
-    { _vao      :: VertexArrayObject
+    { _vaoName  :: VertexArrayObject
     , _vaoVBO   :: VBO
     }
 {- | Vertex buffer object: contains the reference to the object,
@@ -78,7 +78,7 @@ data EBO = EBO
     , _eboPtr   :: Ptr GLushort
     }
 {- | Datatype containing the reference to a texture object.  -}
-data ShaderTexture = ShaderTexture
+newtype ShaderTexture = ShaderTexture
     { _textureObject :: GLuint -- DSA style texture, 450 
 --    , _textureTarget :: GLenum
     }