Reduce rendertype down to vertex information

src/Shader/AuxAddition.hs

@@ -1,6 +1,7 @@
 module Shader.AuxAddition
     ( addTexture
     , addTextureNoFilter
+    , vaddTextureNoFilter
     , addTextureArray
     , addUniforms
     ) where
@@ -34,6 +35,21 @@ addTexture texturePath shad = do
     generateMipmap' Texture2D
     return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
 
+vaddTextureNoFilter :: String -> VShader -> IO VShader
+vaddTextureNoFilter texturePath shad = do
+    Right cmap <- readImage texturePath
+    let tex = convertRGBA8 cmap
+    textureOb <- genObjectName
+    textureBinding Texture2D $= Just textureOb
+    textureFilter Texture2D $= ((Nearest,Nothing) , Nearest)
+    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
+    return $ shad & vshaderTexture ?~ ShaderTexture {_textureObject = textureOb}
+
 addTextureNoFilter :: String -> FullShader -> IO FullShader
 addTextureNoFilter texturePath shad = do
     Right cmap <- readImage texturePath

src/Shader/Compile.hs

@@ -1,5 +1,6 @@
 module Shader.Compile
     ( makeShader
+    , makeVShader
     , makeShaderSized
     , makeShaderUsingShaderVAO
     , makeSourcedShader
@@ -16,6 +17,29 @@ import Control.Monad
 --import Control.Lens
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 
+{- | 
+Compiles a vertex shader found within the shader directory.
+The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
+-}
+makeVShader 
+    :: String       -- ^ First part of the name of the shader
+    -> [ShaderType] -- ^ Filetype extensions
+    -> [Int]   -- ^ The input vertex sizes
+    -> EPrimitiveMode
+    -> (VertexType -> Bool)
+    -> IO VShader
+makeVShader s shaderlist sizes renStrat vtest = do
+    prog <- makeSourcedShader s shaderlist
+    vaob <- setupVAO sizes
+    return $ VShader 
+        { _vshaderProgram = prog
+        , _vshaderVAO = vaob
+        , _vshaderTexture = Nothing
+        , _vshaderCustomUnis = []
+        , _vshaderPokeTest = vtest
+        , _vshaderDrawPrimitive = renStrat
+        }
+
 -- | Takes the VAO and poke strategy from another shader
 makeShaderUsingShaderVAO
     :: String       -- ^ First part of the name of the shader

src/Shader/Data.hs

@@ -6,6 +6,7 @@ module Shader.Data
     ( VAO (..)
     , VBO (..)
     , FullShader (..)
+    , VShader (..)
     , ShaderTexture (..)
     , EPrimitiveMode (..)
 -- | Lens functions
@@ -19,6 +20,13 @@ module Shader.Data
     , shaderTexture
     , shaderCustomUnis
 
+    , vshaderProgram
+    , vshaderVAO
+    , vshaderDrawPrimitive
+    , vshaderTexture
+    , vshaderCustomUnis
+    , vshaderPokeTest
+
 --    , textureObject 
     ) where
 import Picture.Data
@@ -42,6 +50,14 @@ data VBO = VBO
     , _vboPointer :: Ptr Float
     , _vboAttribSizes :: [Int]  -- ^ It is not clear to me if this is necessary to store or not
     }
+data VShader = VShader
+    { _vshaderProgram :: Program
+    , _vshaderVAO :: VAO
+    , _vshaderDrawPrimitive :: EPrimitiveMode
+    , _vshaderTexture :: Maybe ShaderTexture
+    , _vshaderCustomUnis :: [UniformLocation]
+    , _vshaderPokeTest :: VertexType -> Bool
+    }
 
 {- | Datatype containing the necessary information for a single shader.  -}
 data FullShader = FullShader
@@ -72,3 +88,4 @@ data EPrimitiveMode
 
 makeLenses ''VAO
 makeLenses ''FullShader
+makeLenses ''VShader

src/Shader/Poke.hs

@@ -19,13 +19,6 @@ pokeShader fs = F.FoldM (pokeVertices fls ptr stride)  (return 0) return
     stride = sum $ _vboAttribSizes theVBO
     fls = _shaderPokeStrategy fs
 
-pokeShaderLayer :: (Int,FullShader) -> F.FoldM IO (Int,RenderType) Int
-pokeShaderLayer (l,fs) = F.FoldM (pokeVerticesOff fls ptr stride l)  (return 0) return
-  where 
-    theVBO = _vaoVBO $ _shaderVAO fs
-    ptr = _vboPointer theVBO
-    stride = sum $ _vboAttribSizes theVBO
-    fls = _shaderPokeStrategy fs
 
 
 pokeVertices 
@@ -37,17 +30,37 @@ pokeVertices
     -> IO Int
 pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt)
 
+pokeShaderLayer :: (Int,VShader) -> F.FoldM IO Verx Int
+pokeShaderLayer (l,fs) = F.FoldM (pokeVerticesOff ptr (_vshaderPokeTest fs) stride l)  (return 0) return
+  where 
+    theVBO = _vaoVBO $ _vshaderVAO fs
+    ptr = _vboPointer theVBO
+    stride = sum $ _vboAttribSizes theVBO
+
 pokeVerticesOff
-    :: (RenderType -> [[Float]])
-    -> Ptr Float
+    :: Ptr Float
+    -> (VertexType -> Bool)
     -> Int  -- ^ stride
     -> Int  -- ^ offset
     -> Int  -- ^ number of vertices already poked
-    -> (Int,RenderType)
+    -> Verx
     -> IO Int
-pokeVerticesOff toFs ptr stride offset n (i,rt) 
-    | offset == i = foldM (pokeVertexOff ptr stride offset) n (toFs rt)
+pokeVerticesOff ptr vtest stride offset n vx
+    | offset == i && typetest = do
+        foldM (pokeVertexOff ptr stride offset) n (toFls vx)
     | otherwise = return n
+  where
+    i = _vxLayer vx
+    typetest = vtest (_vxType vx)
+
+toFls :: Verx -> [[Float]]
+toFls vx = [flat3 (_vxPos vx) ++ flat4 (_vxCol vx) ++ f (_vxType vx)]
+  where
+    f (PolyzV x) = [x]
+    f (BezV x) = flat4 x
+    f (TextV x) = flat2 x
+    f (ArcV x) = flat3 x
+    f _ = []
 
 pokeVertexOff :: Ptr Float -> Int -> Int -> Int -> [Float] -> IO Int
 pokeVertexOff ptr stride offset n fs = do