From ff1734001d472a41c1049f6742e1dc6cd20993c2 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Fri, 17 Mar 2023 17:48:22 +1300
Subject: [PATCH] Add support for setting text colour, minor fixes.

---
 src/Main.hs | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 159be45..a80c134 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -57,11 +57,15 @@ import Data.Maybe (fromMaybe)
 import System.Environment (getArgs)
 
 type Style = Style.VarParser (CSSTxt.TextStyle (CSSBox VizStyle))
-data VizStyle = VizStyle
+data VizStyle = VizStyle (V4 Float)
 instance Style.PropertyParser VizStyle where
-    temp = VizStyle
-    inherit _ = VizStyle
-    longhand _ _ _ _ = Nothing
+    temp = VizStyle (V4 0 0 0 1)
+    inherit = id
+    longhand _ self "color" [Ident "black"] = VizStyle (V4 0 0 0 1)
+    longhand _ self "color" [Ident "white"] = VizStyle (V4 1 1 1 1)
+    longhand _ self "color" [Ident "red"]   = VizStyle (V4 1 0 0 1)
+    longhand _ self "color" [Ident "green"] = VizStyle (V4 0 1 0 1)
+    longhand _ self "color" [Ident "blue"]  = VizStyle (V4 0 0 1 1)
 
 inlinePseudos' :: Style.PropertyParser s => StyleTree [(Text, Style.VarParser s)] -> StyleTree s
 inlinePseudos' (StyleTree self childs) = StyleTree {
@@ -110,11 +114,11 @@ lowerVars "-rhapsode" = CSSCond.B True
 lowerVars _ = CSSCond.B False
 lowerToks _ = CSSCond.B False
 
-renderLayout atlases drawText (LayoutSpan ((x, y), _) font self)
+renderLayout atlases drawText (LayoutSpan ((x, y), VizStyle color) font self)
     | Just atlas <- M.lookup (pattern font, fontSize font) atlases = do
         drawText' <- drawText atlas $ fragmentGlyphs self
-        -- FIXME Allow CSS to set the colour.
-        liftIO $ arDraw drawText' [TextTransformMultiply $ V4 0 0 0 1]
+        -- FIXME Switch from temp to inherit for inline caller-properties.
+        liftIO $ arDraw drawText' [TextTransformMultiply color]
                         (V2 (fromEnum x) (fromEnum y))
 renderLayout atlases drawText node = do
     layoutGetChilds node `forM` renderLayout atlases drawText
@@ -149,8 +153,8 @@ main = do
 
     let pseudofilter :: CSSPseudo.LowerPsuedoClasses (Style.QueryableStyleSheet Style)
         pseudofilter = CSSPseudo.htmlPsuedoFilter Style.queryableStyleSheet
-    css <- retreiveStyles sess $ css page
-    let css' = CSSPseudo.inner $ resolve' pseudofilter css
+    css0 <- retreiveStyles sess $ css page
+    let css' = CSSPseudo.inner $ resolve' pseudofilter css0
     let style = CSSTxt.resolve $ inlinePseudos' $ stylize css' $ el2stylist $
             documentRoot $ html page
     let sysfont = (pattern2font (nameParse "serif") Style.temp { cssFontSize = (12,"pt") }
@@ -167,7 +171,7 @@ main = do
             windowGraphicsContext = OpenGLContext openGL,
             windowResizable = True
           }
-    w <- createWindow "Typograffiti" wcfg
+    w <- createWindow "Haphaestus" wcfg
     _ <- glCreateContext w
 
     ft_With_FreeType $ \ft -> runExceptT $ do
-- 
2.30.2