Partial refactor of shader loading and drawing

src/Picture/Preload.hs

@@ -29,6 +29,7 @@ data RenderData = RenderData
     , _lightmapCircleShader :: (Program, [UniformLocation])
     , _backShader       :: (Program, [UniformLocation])
     , _wallShadowShader :: (Program, [UniformLocation])
+    , _listShaders :: [FullShader]
     , _triVAO :: VAO
     , _lineVAO :: VAO
     , _textVAO :: VAO
@@ -45,6 +46,43 @@ data RenderData = RenderData
 
 makeLenses ''RenderData
 
+makeShader :: String -> [ShaderType] -> [(GLuint,Int)] -> PrimitiveMode -> (RenderType -> [[[Float]]]) -> IO FullShader
+makeShader s shaderlist alocs pm renStrat = do
+    (prog,unis)  <- makeSourcedShader s shaderlist
+    vao        <- setupVAO alocs
+    return $ FullShader { _shaderProgram = prog
+                        , _shaderUniforms = unis
+                        , _shaderVAO = vao
+                        , _shaderPokeStrategy = renStrat
+                        , _shaderDrawPrimitive = pm
+                        }
+
+mkS :: IO FullShader
+mkS = do 
+    (prog,unis)  <- makeSourcedShader "basic"      [VertexShader,FragmentShader]
+    trivao        <- setupVAO [(0,3),(1,4)]
+    return $ FullShader { _shaderProgram = prog
+                        , _shaderUniforms = unis
+                        , _shaderVAO = trivao
+                        , _shaderPokeStrategy = pokeTriStrat
+                        , _shaderDrawPrimitive = Triangles
+                        }
+
+pokeTriStrat (RenderPoly vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
+pokeTriStrat _ = []
+
+pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> flat3 (flat3 a, flat4 b, flat3 c)) vs
+pokeCharStrat _ = []
+
+pokeArcStrat (RenderArc (a,b,c)) = [flat3 (flat3 a, flat4 b, flat4 c)]
+pokeArcStrat _ = []
+
+pokeLineStrat (RenderLine vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
+pokeLineStrat _ = []
+
+pokeEllStrat (RenderEllipse vs) = fmap (\((x,y,z),(r,g,b,a)) -> [[x,y,z],[r,g,b,a]]) vs
+pokeEllStrat _ = []
+
 floatSize = sizeOf (0.5 :: GLfloat)
 
 setupVAO :: [(GLuint,Int)] -> IO VAO
@@ -92,6 +130,10 @@ loadTextures = do
 bufferOffset :: Integral a => a -> Ptr b
 bufferOffset = plusPtr nullPtr . fromIntegral
 
+vert = VertexShader
+geom = GeometryShader
+frag = FragmentShader
+
 preloadRender :: IO RenderData
 preloadRender = do
 -- compile shader programs
@@ -106,6 +148,12 @@ preloadRender = do
 
     wssLightPosUniLoc   <- GL.uniformLocation (fst wss) "lightPos"
 
+    bslist <- makeShader "basic"        [vert,frag] [(0,3),(1,4)] Triangles pokeTriStrat
+    lslist <- makeShader "basic"        [vert,frag] [(0,3),(1,4)] Lines pokeLineStrat
+    cslist <- makeShader "character"    [vert,geom,frag] [(0,3),(1,4),(2,3)] Points pokeCharStrat
+    aslist <- makeShader "arc"          [vert,geom,frag] [(0,3),(1,4),(2,3)] Points pokeArcStrat
+    eslist <- makeShader "ellipseInterpolate" [vert,geom,frag] [(0,3),(1,4)] Triangles pokeEllStrat
+
 --the following vbo is set up to contain one fixed vertex
     dummyvbo <- genObjectName
     dummyptr <- mallocArray numDrawableElements
@@ -163,6 +211,7 @@ preloadRender = do
         , _circShader = cs
         , _ellipseShader = es
         , _arcShader = as
+        , _listShaders = [bslist,lslist,cslist,aslist,eslist]
         , _lightmapCircleShader = fcs
         , _backShader = bgs
         , _wallShadowShader = wss