From c4545d724d0b4ab588e707f0d4196c8102c4fdd8 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Wed, 25 Jan 2023 12:13:54 +1300
Subject: [PATCH] Resurrect optimizations using Vectors for lists.

---
 src/Typograffiti/Atlas.hs | 8 ++++----
 src/Typograffiti/Cache.hs | 8 ++++----
 src/Typograffiti/GL.hs    | 7 ++++---
 3 files changed, 12 insertions(+), 11 deletions(-)

diff --git a/src/Typograffiti/Atlas.hs b/src/Typograffiti/Atlas.hs
index d2a1a75..7ae8a45 100644
--- a/src/Typograffiti/Atlas.hs
+++ b/src/Typograffiti/Atlas.hs
@@ -165,7 +165,7 @@ allocAtlas cb glyphs = do
 freeAtlas :: MonadIO m => Atlas -> m ()
 freeAtlas a = liftIO $ with (atlasTexture a) $ \ptr -> glDeleteTextures 1 ptr
 
-type Quads = (Float, Float, [(V2 Float, V2 Float)])
+type Quads = (Float, Float, [Vector (V2 Float, V2 Float)])
 makeCharQuad :: (MonadIO m, MonadError TypograffitiError m) =>
     Atlas -> Quads -> (GlyphInfo, GlyphPos) -> m Quads
 makeCharQuad Atlas {..} (penx, peny, mLast) (GlyphInfo {codepoint=glyph}, GlyphPos {..}) = do
@@ -186,7 +186,7 @@ makeCharQuad Atlas {..} (penx, peny, mLast) (GlyphInfo {codepoint=glyph}, GlyphP
                 bl = (V2 (x) y, V2 (texL/aszW) (texB/aszH))
 
             return (penx + f x_advance/150, peny + f y_advance/150,
-                    mLast ++ [tl, tr, br, tl, br, bl])
+                    UV.fromList [tl, tr, br, tl, br, bl] : mLast)
   where
     f :: Int32 -> Float
     f = fromIntegral
@@ -197,7 +197,7 @@ stringTris :: (MonadIO m, MonadError TypograffitiError m) =>
     Atlas -> [(GlyphInfo, GlyphPos)] -> m Quads
 stringTris atlas = foldM (makeCharQuad atlas) (0, 0, [])
 stringTris' :: (MonadIO m, MonadError TypograffitiError m) =>
-    Atlas -> [(GlyphInfo, GlyphPos)] -> m [(V2 Float, V2 Float)]
+    Atlas -> [(GlyphInfo, GlyphPos)] -> m (Vector (V2 Float, V2 Float))
 stringTris' atlas glyphs = do
     (_, _, ret) <- stringTris atlas glyphs
-    return ret
+    return $ UV.concat $ reverse ret
diff --git a/src/Typograffiti/Cache.hs b/src/Typograffiti/Cache.hs
index 34e1f78..1983a4a 100644
--- a/src/Typograffiti/Cache.hs
+++ b/src/Typograffiti/Cache.hs
@@ -80,9 +80,9 @@ makeDrawGlyphs = do
         vao   <- newBoundVAO
         pbuf  <- newBuffer
         uvbuf <- newBuffer
-        (ps, uvs) <- unzip <$> stringTris' atlas glyphs
-        bufferGeometry position pbuf $ UV.fromList ps
-        bufferGeometry uv uvbuf $ UV.fromList uvs
+        (ps, uvs) <- UV.unzip <$> stringTris' atlas glyphs
+        bufferGeometry position pbuf ps
+        bufferGeometry uv uvbuf uvs
         glBindVertexArray 0
 
         let draw ts wsz = do
@@ -95,7 +95,7 @@ makeDrawGlyphs = do
                 updateUniform prog texU (0 :: Int)
                 glBindVertexArray vao
                 withBoundTextures [atlasTexture atlas] $ do
-                    drawVAO prog vao GL_TRIANGLES (fromIntegral $ length ps)
+                    drawVAO prog vao GL_TRIANGLES (fromIntegral $ UV.length ps)
                     glBindVertexArray 0
             release = do
                 withArray [pbuf, uvbuf] $ glDeleteBuffers 2
diff --git a/src/Typograffiti/GL.hs b/src/Typograffiti/GL.hs
index 575e89c..d61e936 100644
--- a/src/Typograffiti/GL.hs
+++ b/src/Typograffiti/GL.hs
@@ -355,9 +355,10 @@ orthoProjection (V2 ww wh) =
   in ortho 0 hw hh 0 0 1
 
 
-boundingBox :: (Unbox a, Real a, Fractional a) => [V2 a] -> (V2 a, V2 a)
-boundingBox [] = (0, 0)
-boundingBox vs = foldl' f (br,tl) vs
+boundingBox :: (Unbox a, Real a, Fractional a) => UV.Vector (V2 a) -> (V2 a, V2 a)
+boundingBox vs
+  | UV.null vs = (0,0)
+  | otherwise = UV.foldl' f (br,tl) vs
   where mn a = min a . realToFrac
         mx a = max a . realToFrac
         f (a, b) c = (mn <$> a <*> c, mx <$> b <*> c)
-- 
2.30.2