From 9f4497fb391bbb1a90d6467d9ca52263815619d8 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Mon, 15 Feb 2021 14:03:15 +0100
Subject: [PATCH] Implement text rendering using geometry shader

---
 src/Geometry/Data.hs  |  2 ++
 src/Picture.hs        | 33 ++++++++++++++++++++++-----------
 src/Picture/Render.hs |  2 +-
 src/Shaders.hs        |  2 ++
 4 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/src/Geometry/Data.hs b/src/Geometry/Data.hs
index 6e8029175..8f985d3b7 100644
--- a/src/Geometry/Data.hs
+++ b/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)
diff --git a/src/Picture.hs b/src/Picture.hs
index 3037446b6..df297666c 100644
--- a/src/Picture.hs
+++ b/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)        
-                  ,(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)]
+    ,_scPosChar = toVC [(0.0,0.0,0)]
+    ,_scColChar = toVC [white]
+    ,_scTexChar = toVC [(offset,100)]
     }
     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
diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs
index 0cef204d7..e710166a1 100644
--- a/src/Picture/Render.hs
+++ b/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')
 
 
 
diff --git a/src/Shaders.hs b/src/Shaders.hs
index 78e76669d..c976690aa 100644
--- a/src/Shaders.hs
+++ b/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 )
                       ]