From 79c5cd4691c26d69867eee511802d356352aefd9 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Fri, 2 Jun 2023 16:42:59 +1200 Subject: [PATCH] Implement unicode-bidi-property, attempted. Doesn't handle tree. --- Graphics/Layout/CSS.hs | 2 +- Graphics/Layout/CSS/Parse.hs | 4 +- Graphics/Layout/Inline/CSS.hs | 95 +++++++++++++++++++++++++++-------- 3 files changed, 78 insertions(+), 23 deletions(-) diff --git a/Graphics/Layout/CSS.hs b/Graphics/Layout/CSS.hs index f142565..4fa90c8 100644 --- a/Graphics/Layout/CSS.hs +++ b/Graphics/Layout/CSS.hs @@ -91,7 +91,7 @@ finalizeChilds root parent style' childs@(child:childs') $ flip applyFontInline f $ txtOpts self) defaultBoxOptions -- Fill in during layout. where f = pattern2font (font self) (font' self) p root - flattenTree f (i,StyleTree {style=self@CSSBox {inlineStyles=CSSInline txt _}}) + flattenTree f (i,StyleTree {style=self@CSSBox {inlineStyles=CSSInline txt _ _}}) = InlineBox ((f, i), finalizeBox self f, inner self) (Box [TextSequence ((f, 0), zero, inherit $ inner self) txt] $ flip applyFontInline f $ txtOpts self) diff --git a/Graphics/Layout/CSS/Parse.hs b/Graphics/Layout/CSS/Parse.hs index 5050ab6..7cb7efa 100644 --- a/Graphics/Layout/CSS/Parse.hs +++ b/Graphics/Layout/CSS/Parse.hs @@ -45,9 +45,9 @@ data CSSBox a = CSSBox { pageOptions :: PageOptions } -- | Accessor for inlineStyle's `textDirection` attribute. -direction CSSBox { inlineStyles = CSSInline _ opts } = textDirection opts +direction CSSBox { inlineStyles = CSSInline _ opts _ } = textDirection opts -- | Accessor for inlineStyle's options. -txtOpts CSSBox { inlineStyles = CSSInline _ opts } = opts +txtOpts CSSBox { inlineStyles = CSSInline _ opts _ } = opts -- | Possible values for CSS box-sizing. data BoxSizing = BorderBox | ContentBox -- | Empty border, to use as default value. diff --git a/Graphics/Layout/Inline/CSS.hs b/Graphics/Layout/Inline/CSS.hs index 759b6c3..7abc0ce 100644 --- a/Graphics/Layout/Inline/CSS.hs +++ b/Graphics/Layout/Inline/CSS.hs @@ -1,42 +1,64 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ViewPatterns #-} -- | Infrastructure for parsing & desugaring text related CSS properties. -module Graphics.Layout.Inline.CSS(CSSInline(..), applyFontInline) where +module Graphics.Layout.Inline.CSS(CSSInline(..), applyFontInline, applyBidi) where import Data.CSS.Syntax.Tokens (Token(..)) import Stylist (PropertyParser(..)) import qualified Data.Text as Txt -import Data.Text.Internal (Text(..)) +import Data.Text (Text, cons, snoc) import Data.Text.ParagraphLayout.Rich import Data.Text.Glyphize (Direction(..)) import Graphics.Layout.CSS.Font (Font'(..), hbUnit) import Data.Char (isSpace) +import Debug.Trace (trace) -- To report unexpected cases. -- | Document text with Balkón styling options, CSS stylable. -data CSSInline = CSSInline Txt.Text TextOptions +data CSSInline = CSSInline Txt.Text TextOptions UnicodeBidi +-- | To what degree is the text direction isolated? +data UnicodeBidi = BdNormal | BdEmbed | BdOverride | BdIsolate + | BdIsolateOverride | BdPlainText deriving (Eq, Ord, Enum, Read, Show) instance PropertyParser CSSInline where - temp = CSSInline "" $ defaultTextOptions DirLTR - inherit (CSSInline _ opts) = CSSInline "" opts + temp = CSSInline "" (defaultTextOptions DirLTR) BdNormal + inherit (CSSInline _ opts _) = CSSInline "" opts BdNormal priority _ = ["direction"] -- To inform logical spacing in caller! - longhand _ (CSSInline _ o) "content" [Ident "initial"] = Just $ CSSInline "" o - longhand _ (CSSInline _ opts) "content" toks + longhand _ (CSSInline _ opts bidi) "content" [Ident "initial"] = + Just $ CSSInline "" opts bidi + longhand _ (CSSInline _ opts bidi) "content" toks | all isString toks = - Just $ CSSInline (Txt.concat [x | String x <- toks]) opts + Just $ CSSInline (Txt.concat [x | String x <- toks]) opts bidi where isString (String _) = True isString _ = False - longhand _ (CSSInline t o) "-argo-lang" [Ident kw] - | kw `elem` ["initial", "auto"] = Just $ CSSInline t o {textLanguage=""} - longhand _ (CSSInline txt opts) "-argo-lang" [String x] = - Just $ CSSInline txt opts { textLanguage = Txt.unpack x } - longhand _ (CSSInline txt opts) "direction" [Ident "ltr"] = - Just $ CSSInline txt opts { textDirection = DirLTR } - longhand _ (CSSInline txt opts) "direction" [Ident "rtl"] = - Just $ CSSInline txt opts { textDirection = DirRTL } - longhand _ (CSSInline txt opts) "direction" [Ident "initial"] = - Just $ CSSInline txt opts { textDirection = DirLTR } + + longhand _ (CSSInline t o b) "-argo-lang" [Ident kw] + | kw `elem` ["initial", "auto"] = Just $ CSSInline t o {textLanguage=""} b + longhand _ (CSSInline txt opts bidi) "-argo-lang" [String x] = + Just $ CSSInline txt opts { textLanguage = Txt.unpack x } bidi + + longhand _ (CSSInline txt opts bidi) "direction" [Ident "ltr"] = + Just $ CSSInline txt opts { textDirection = DirLTR } bidi + longhand _ (CSSInline txt opts bidi) "direction" [Ident "rtl"] = + Just $ CSSInline txt opts { textDirection = DirRTL } bidi + longhand _ (CSSInline txt opts bidi) "direction" [Ident "initial"] = + Just $ CSSInline txt opts { textDirection = DirLTR } bidi + + longhand _ (CSSInline txt opts _) "unicode-bidi" [Ident "initial"] = + Just $ CSSInline txt opts BdNormal + longhand _ (CSSInline txt opts _) "unicode-bidi" [Ident "normal"] = + Just $ CSSInline txt opts BdNormal + longhand _ (CSSInline txt opts _) "unicode-bidi" [Ident "embed"] = + Just $ CSSInline txt opts BdEmbed + longhand _ (CSSInline txt opts _) "unicode-bidi" [Ident "isolate"] = + Just $ CSSInline txt opts BdIsolate + longhand _ (CSSInline txt opts _) "unicode-bidi" [Ident "bidi-override"] = + Just $ CSSInline txt opts BdOverride + longhand _ (CSSInline txt opts _) "unicode-bidi" [Ident "isolate-override"] = + Just $ CSSInline txt opts BdIsolateOverride + longhand _ (CSSInline txt opts _) "unicode-bidi" [Ident "plaintext"] = + Just $ CSSInline txt opts BdPlainText longhand _ _ _ _ = Nothing applyFontInline :: TextOptions -> Font' -> TextOptions @@ -44,5 +66,38 @@ applyFontInline opts font = opts { textFont = hbFont font, textLineHeight = Absolute $ toEnum $ fromEnum $ lineheight font * hbUnit } +-- | Apply Bidi chars around the inline text. FIXME: Handle the tree! +applyBidi :: CSSInline -> Text +applyBidi (CSSInline txt _ BdNormal) = txt +applyBidi (CSSInline txt (textDirection -> DirLTR) BdEmbed) = + chLREmbed `cons` txt `snoc` chPopDir +applyBidi (CSSInline txt (textDirection -> DirRTL) BdEmbed) = + chRLEmbed `cons` txt `snoc` chPopDir +applyBidi (CSSInline txt (textDirection -> DirLTR) BdIsolate) = + chLRIsolate `cons` txt `snoc` chPopDirIsolate +applyBidi (CSSInline txt (textDirection -> DirRTL) BdIsolate) = + chRLIsolate `cons` txt `snoc` chPopDirIsolate +applyBidi (CSSInline txt (textDirection -> DirLTR) BdOverride) = + chLROverride `cons` txt `snoc` chPopDir +applyBidi (CSSInline txt (textDirection -> DirRTL) BdOverride) = + chRLOverride `cons` txt `snoc` chPopDir +applyBidi (CSSInline txt (textDirection -> DirLTR) BdIsolateOverride) = + ch1stStrongIsolate `cons` chLROverride `cons` txt + `snoc` chPopDir `snoc` chPopDirIsolate +applyBidi (CSSInline txt (textDirection -> DirRTL) BdIsolateOverride) = + ch1stStrongIsolate `cons` chRLOverride `cons` txt + `snoc` chPopDir `snoc` chPopDirIsolate +applyBidi (CSSInline txt _ BdPlainText) = + ch1stStrongIsolate `cons` txt `snoc` chPopDirIsolate +applyBidi (CSSInline txt (textDirection -> dir) _) = + trace ("Unexpected direction! " ++ show dir) txt - +chLREmbed = '\x202A' +chRLEmbed = '\x202B' +chLROverride = '\x202D' +chRLOverride = '\x202E' +chPopDir = '\x202C' +chLRIsolate = '\x2066' +chRLIsolate = '\x2067' +ch1stStrongIsolate = '\x2068' +chPopDirIsolate = '\x2069' -- 2.30.2