From a1a78d251a8e2f67c0e26815b73dfc774ed3a848 Mon Sep 17 00:00:00 2001
From: Jaro <jaro@argonaut-constellation.org>
Date: Sun, 19 Mar 2023 18:08:01 +0100
Subject: [PATCH] Allow custom font options outside FontLoader.

---
 test/Data/Text/ParagraphLayout/FontLoader.hs | 51 ++++++++------------
 test/Data/Text/ParagraphLayoutSpec.hs        | 19 ++++++--
 2 files changed, 35 insertions(+), 35 deletions(-)

diff --git a/test/Data/Text/ParagraphLayout/FontLoader.hs b/test/Data/Text/ParagraphLayout/FontLoader.hs
index cc86645..057c994 100644
--- a/test/Data/Text/ParagraphLayout/FontLoader.hs
+++ b/test/Data/Text/ParagraphLayout/FontLoader.hs
@@ -1,48 +1,35 @@
 module Data.Text.ParagraphLayout.FontLoader
-    (loadPlexSansArabicRegular
-    ,loadSaralaRegular
-    ,loadUbuntuRegular
+    (arabicFont
+    ,devanagariFont
+    ,latinFont
+    ,loadFont
     )
 where
 
 import Data.ByteString (readFile)
 import Data.Text.Glyphize
     (Font
-    ,FontOptions(optionPPEm, optionScale)
+    ,FontOptions
     ,createFace
     ,createFontWithOptions
-    ,defaultFontOptions
     )
-import Prelude (IO, Int, Maybe(Just), String, Word, return, ($))
-import System.FilePath ((</>))
+import Data.Word (Word)
+import Prelude (return)
+import System.FilePath (FilePath, (</>))
+import System.IO (IO)
 
--- TODO: Figure out if this affects hinting!
-testingPixelSize :: (Word, Word)
-testingPixelSize = (24, 24)
+arabicFont :: FilePath
+arabicFont = "assets" </> "fonts" </> "plex" </> "IBMPlexSansArabic-Regular.ttf"
 
--- This controls the output units.
--- The default is "unscaled", which uses the value of `faceUpem` in both axes.
-testingScale :: (Int, Int)
-testingScale = (1000, 1000)
+devanagariFont :: FilePath
+devanagariFont = "assets" </> "fonts" </> "sarala" </> "Sarala-Regular.ttf"
 
-loadPlexSansArabicRegular :: IO Font
-loadPlexSansArabicRegular = loadFontFromFile $
-    "assets" </> "fonts" </> "plex" </> "IBMPlexSansArabic-Regular.ttf"
+latinFont :: FilePath
+latinFont = "assets" </> "fonts" </> "ubuntu" </> "Ubuntu-R.ttf"
 
-loadSaralaRegular :: IO Font
-loadSaralaRegular = loadFontFromFile $
-    "assets" </> "fonts" </> "sarala" </> "Sarala-Regular.ttf"
-
-loadUbuntuRegular :: IO Font
-loadUbuntuRegular = loadFontFromFile $
-    "assets" </> "fonts" </> "ubuntu" </> "Ubuntu-R.ttf"
-
-loadFontFromFile :: String -> IO Font
-loadFontFromFile path = do
+loadFont :: FilePath -> Word -> FontOptions -> IO Font
+loadFont path index opts = do
     ttf <- readFile path
-    let face = createFace ttf 0
-    let font = createFontWithOptions (defaultFontOptions {
-        optionPPEm = Just testingPixelSize,
-        optionScale = Just testingScale
-    }) face
+    let face = createFace ttf index
+    let font = createFontWithOptions opts face
     return font
diff --git a/test/Data/Text/ParagraphLayoutSpec.hs b/test/Data/Text/ParagraphLayoutSpec.hs
index b0c94f8..bccf991 100644
--- a/test/Data/Text/ParagraphLayoutSpec.hs
+++ b/test/Data/Text/ParagraphLayoutSpec.hs
@@ -1,5 +1,10 @@
 module Data.Text.ParagraphLayoutSpec (spec) where
 
+import Data.Text.Glyphize
+    (FontOptions(optionPPEm, optionScale)
+    ,defaultFontOptions
+    )
+
 import Test.Hspec
 import Test.Hspec.Golden
 import System.FilePath ((</>))
@@ -107,6 +112,14 @@ emptyLayout = ParagraphLayout (Rect 0 0 0 0) []
 emptySpanLayout :: ParagraphLayout
 emptySpanLayout = ParagraphLayout (Rect 0 0 0 0) [SpanLayout []]
 
+-- Test primarily with a high level of detail (1000 units per EM).
+-- Hinting should behave as if the font size were 24px.
+-- TODO: Test hinting.
+testingOptions :: FontOptions
+testingOptions = defaultFontOptions {
+    optionPPEm = Just (24, 24),
+    optionScale = Just (1000, 1000)
+}
 
 spec :: Spec
 spec = do
@@ -114,7 +127,7 @@ spec = do
     describe "layoutPlain" $ do
 
         describe "with Arabic font" $ do
-            font <- runIO $ loadPlexSansArabicRegular
+            font <- runIO $ loadFont arabicFont 0 testingOptions
 
             it "handles input with no spans" $ do
                 let opts = ParagraphOptions font Normal 8000
@@ -138,7 +151,7 @@ spec = do
                 paragraphRect withoutSpans `shouldBe` paragraphRect withSpans
 
         describe "with Devanagari font" $ do
-            font <- runIO $ loadSaralaRegular
+            font <- runIO $ loadFont devanagariFont 0 testingOptions
 
             describe "lone accent character" $ do
                 let
@@ -171,7 +184,7 @@ spec = do
 
         describe "with Latin font" $ do
             -- Note: This font does not contain Japanese glyphs.
-            font <- runIO $ loadUbuntuRegular
+            font <- runIO $ loadFont latinFont 0 testingOptions
 
             it "handles input with no spans" $ do
                 let opts = ParagraphOptions font Normal 8000
-- 
2.30.2