From 18cf089a286a1e7880096034563a4490e986ae56 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Wed, 15 Mar 2023 18:23:59 +1300
Subject: [PATCH] Integrate Typograffiti text rendering!

---
 src/Main.hs | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index f05519e..5b1fc3e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -31,13 +31,17 @@ import           Graphics.Layout.CSS (CSSBox(..), finalizeCSS')
 import           Graphics.Layout.CSS.Internal (placeholderFont, Font'(..),
                                                 pattern2font, hbScale, CSSFont(..))
 import           Graphics.Layout.Box as B (zeroBox, PaddedBox(..), Size(..))
-import           Graphics.Layout (boxLayout, glyphsPerFont)
+import           Graphics.Layout (boxLayout, glyphsPerFont, LayoutItem(..))
 import           Graphics.Text.Font.Choose (nameParse)
 
 import           FreeType.FontConfig (instantiatePattern, bmpAndMetricsForIndex,
                                       FTFC_Subpixel(..))
 import           FreeType.Core.Base (ft_With_FreeType)
-import           Typograffiti (makeDrawGlyphs, allocAtlas)
+import           Typograffiti (makeDrawGlyphs, allocAtlas, AllocatedRendering(..),
+                                TextTransformMultiply(..))
+import           Linear.V4 (V4(..))
+import           Linear.V2 (V2(..))
+import           Data.Text.ParagraphLayout (Fragment(..))
 
 import SDL hiding (rotate)
 import Graphics.GL.Core32
@@ -106,6 +110,13 @@ lowerVars "-rhapsode" = CSSCond.B True
 lowerVars _ = CSSCond.B False
 lowerToks _ = CSSCond.B False
 
+renderLayout drawText (LayoutSpan ((x, y), _) font self) = do
+    drawText' <- drawText $ fragmentGlyphs self
+    -- FIXME Allow CSS to set the colour.
+    liftIO $ arDraw drawText' [TextTransformMultiply $ V4 0 0 0 1]
+                    (V2 (fromEnum x) (fromEnum y))
+renderLayout drawText node = layoutGetChilds node `forM` renderLayout drawText
+
 main :: IO ()
 main = do
     sess <- newSession
@@ -168,7 +179,7 @@ main = do
 
         fix $ \loop -> do
             events <- fmap eventPayload <$> pollEvents
-            liftIO $ glClearColor 0 0 0 1
+            liftIO $ glClearColor 1 1 1 1
             liftIO $ glClear GL_COLOR_BUFFER_BIT
 
             sz@(V2 dw dh) <- liftIO $ glGetDrawableSize w
@@ -178,6 +189,8 @@ main = do
             let outerbox = zeroBox { B.min = size, B.size = size, B.max = size }
             let layout = boxLayout outerbox (finalizeCSS' sysfont style) False
 
+            renderLayout layout
+
             liftIO $ glSwapWindow w
             unless (QuitEvent `elem` events) loop
     return ()
-- 
2.30.2