Implement text rendering using geometry shader

src/Geometry/Data.hs

@@ -1,8 +1,10 @@
 module Geometry.Data
     ( Point2 (..)
     , Point3 (..)
+    , Point4 (..)
     )
     where
 
 type Point2 = (Float,Float)
 type Point3 = (Float,Float,Float)
+type Point4 = (Float,Float,Float,Float)

src/Picture.hs

@@ -113,7 +113,7 @@ scale3 a b (x,y,z) = (x*a,y*b,z)
 scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
 --scale x y = over scPosTri (mapVC $ scale3 x y) . over scPosChar (mapVC $ scale3 x y)
-scale x y = overPos $ scale3 x y
+scale x y pic = overPos (scale3 x y) $ over scTexChar (fmap (second (*x))) pic
 
 rotate3 :: Float -> Point3 -> Point3
 {-# INLINE rotate3 #-}
@@ -170,20 +170,31 @@ charToScene :: Char -> Picture
 charToScene c = Scene
     {_scPosTri = mempty
     ,_scColTri = mempty
-    ,_scPosChar = toVC [(0.0    ,0.0      ,0)        
+    ,_scPosChar = toVC [(0.0,0.0,0)]
-                  ,(dimText,0.0      ,0)    
+    ,_scColChar = toVC [white]
-                  ,(dimText,dimText*2,0)
+    ,_scTexChar = toVC [(offset,100)]
-                  ,(0.0    ,0.0      ,0)        
-                  ,(dimText,dimText*2,0)
-                  ,(0.0    ,dimText*2,0)    
-                  ]
-    ,_scColChar = toVC $ take 6 $ repeat white
-    ,_scTexChar = toVC $ [(s,1) ,(e,1) ,(e,0) ,(s,1) ,(e,0) ,(s,0)]
     }
     where x = 1/128
           s = offset * x
-          e = s + x
           offset = fromIntegral (fromEnum c) - 32
+--charToScene :: Char -> Picture
+--charToScene c = Scene
+--    {_scPosTri = mempty
+--    ,_scColTri = mempty
+--    ,_scPosChar = toVC [(0.0    ,0.0      ,0)        
+--                  ,(dimText,0.0      ,0)    
+--                  ,(dimText,dimText*2,0)
+--                  ,(0.0    ,0.0      ,0)        
+--                  ,(dimText,dimText*2,0)
+--                  ,(0.0    ,dimText*2,0)    
+--                  ]
+--    ,_scColChar = toVC $ take 6 $ repeat white
+--    ,_scTexChar = toVC $ [(s,1) ,(e,1) ,(e,0) ,(s,1) ,(e,0) ,(s,0)]
+--    }
+--    where x = 1/128
+--          s = offset * x
+--          e = s + x
+--          offset = fromIntegral (fromEnum c) - 32
     
 
 dimText = 100

src/Picture/Render.hs

@@ -78,7 +78,7 @@ renderPicture' pdata (Scene posTri colTri posChar colChar texChar) = do
     bindBuffer ArrayBuffer $= Just (_texVBO pdata)
     pokeArray (_ptrTexVBO pdata) $ mapFlat flat2 texChar
     bufferData ArrayBuffer $= (fromIntegral (2 * numVertices' * vertexSize'), _ptrTexVBO pdata, StreamDraw)
-    drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ numVertices')
+    drawArrays Points (fromIntegral firstIndex) (fromIntegral $ numVertices')
 
 
 

src/Shaders.hs

@@ -54,9 +54,11 @@ setupFadeShader = do
 makeTextureShader :: IO Program
 makeTextureShader = do
     vsSource <- BS.readFile "shader/basicTexture.vert"
+    gsSource <- BS.readFile "shader/basicTexture.geom"
     fsSource <- BS.readFile "shader/basicTexture.frag"
 
     makeShaderProgram [(VertexShader,   vsSource )
+                      ,(GeometryShader, gsSource )
                       ,(FragmentShader, fsSource )
                       ]