module Data.Text.ParagraphLayout.RichSpec (spec) where
import Data.Int (Int32)
import Data.Word (Word32)
import Data.Text.Glyphize (Direction (DirLTR, DirRTL), codepoint)
import Test.Hspec
import System.FilePath ((</>))
import Data.Text.ParagraphLayout
import Data.Text.ParagraphLayout.FontLoader
import Data.Text.ParagraphLayout.Internal.Paginable (paginateAll)
import Data.Text.ParagraphLayout.Internal.Rich.ParagraphLayout (shapedRuns)
import Data.Text.ParagraphLayout.PrettyShow
import Data.Text.ParagraphLayout.PrettyShow.Golden
import Data.Text.ParagraphLayout.Rect
import Data.Text.ParagraphLayout.Rich
import Data.Text.ParagraphLayout.Rich.ParagraphData
fragmentRects :: ParagraphLayout d -> [(d, Rect Int32)]
fragmentRects p = map toItem $ paragraphFragments p
where toItem (Fragment { fragmentUserData = d, fragmentRect = r }) = (d, r)
glyphRuns :: ParagraphLayout d -> [[Word32]]
glyphRuns = map (map (codepoint . fst) . fragmentGlyphs) . paragraphFragments
spec :: Spec
spec = do
describe "layoutRich" $ do
let
goldenDir = ".golden" </> "richParagraphLayout"
shouldBeGolden = goldenTest goldenDir id id
describe "with Latin font" $ do
font <- runIO $ loadFont latinFont 0 testingOptions
fontSmall <- runIO $ loadFont latinFont 0 testingOptionsSmall
it "wraps lorem ipsum at 20em" $ do
let opts = defaultParagraphOptions { paragraphMaxWidth = 20000 }
let input = loremIpsumParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "loremIpsum20em"
it "handles mixed sizes" $ do
let opts = defaultParagraphOptions
let input = mixedSizesParagraph (font, fontSmall) opts
let result = layoutRich input
result `shouldBeGolden` "mixedSizes"
it "handles mixed script" $ do
let opts = defaultParagraphOptions
let input = mixedScriptParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "mixedScript"
it "handles mixed script with line wraps" $ do
let opts = defaultParagraphOptions { paragraphMaxWidth = 5000 }
let input = mixedScriptParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "mixedScriptWrap"
it "handles nested boxes" $ do
let opts = defaultParagraphOptions
let input = nestedBoxesParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "nestedBoxes"
it "handles hard break in LTR boxes" $ do
let opts = defaultParagraphOptions
let input = hardBoxBreakLTRParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "hardBoxBreakLTR"
it "breaks line early if box spacing does not fit" $ do
let lineH = -1121
let lineY n = lineH * (n - 1)
let wordAdvancesWithSpace = [3134, 2954, 2659, 1332, 2601]
let spaceAdvance = 231
let wordW n = wordAdvancesWithSpace !! (n - 1)
let wordW_ n = wordW n - spaceAdvance
let originX = 0
let wordX n =
originX + (sum $ take (n - 1) wordAdvancesWithSpace)
let endX = originX + (sum wordAdvancesWithSpace)
-- A paragraph exactly wide enough to fit the whole text.
let opts = defaultParagraphOptions { paragraphMaxWidth = endX }
-- Small spacing that should push one word onto the next line.
let s = 5
-- Large spacing that should push two words onto the next line.
let s' = wordW 5 + spaceAdvance + 1
let inputNoSpacing = softBreakParagraph 0 font opts
let inputSmallSpacing = softBreakParagraph s font opts
let inputLargeSpacing = softBreakParagraph s' font opts
let resultNoSpacing = layoutRich inputNoSpacing
let resultSmallSpacing = layoutRich inputSmallSpacing
let resultLargeSpacing = layoutRich inputLargeSpacing
fragmentRects resultNoSpacing `shouldBe`
[ ("text1", Rect (wordX 1) (lineY 1) (wordW 1) lineH)
, ("text2", Rect (wordX 2) (lineY 1) (wordW 2) lineH)
, ("text3", Rect (wordX 3) (lineY 1) (wordW 3) lineH)
, ("text4", Rect (wordX 4) (lineY 1) (wordW 4) lineH)
, ("text5", Rect (wordX 5) (lineY 1) (wordW 5) lineH)
]
fragmentRects resultSmallSpacing `shouldBe`
[ ("text1", Rect (wordX 1) (lineY 1) (wordW 1) lineH)
, ("text2", Rect (wordX 2) (lineY 1) (wordW 2) lineH)
, ("text3", Rect (wordX 3 + s) (lineY 1) (wordW 3) lineH)
, ("text4", Rect (wordX 4 + s) (lineY 1) (wordW_ 4) lineH)
, ("text5", Rect originX (lineY 2) (wordW 5) lineH)
]
fragmentRects resultLargeSpacing `shouldBe`
[ ("text1", Rect (wordX 1) (lineY 1) (wordW 1) lineH)
, ("text2", Rect (wordX 2) (lineY 1) (wordW 2) lineH)
, ("text3", Rect (wordX 3 + s') (lineY 1) (wordW_ 3) lineH)
, ("text4", Rect originX (lineY 2) (wordW 4) lineH)
, ("text5",
Rect (originX + wordW 4) (lineY 2) (wordW 5) lineH)
]
describe "with Arabic font" $ do
font <- runIO $ loadFont arabicFont 0 testingOptions
it "handles hard break in RTL boxes" $ do
let opts = defaultParagraphOptions
let input = hardBoxBreakRTLParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "hardBoxBreakRTL"
it "handles neutral characters in RTL paragraph" $ do
let opts = defaultParagraphOptions
let input = neutralDirectionParagraph DirRTL font opts
let result = layoutRich input
result `shouldBeGolden` "neutralDirectionRTL"
it "handles neutral characters in LTR paragraph" $ do
let opts = defaultParagraphOptions
let input = neutralDirectionParagraph DirLTR font opts
let result = layoutRich input
result `shouldBeGolden` "neutralDirectionLTR"
it "handles simple mixed direction in RTL paragraph" $ do
let opts = defaultParagraphOptions
let input = mixedDirectionSimpleParagraph DirRTL font opts
let result = layoutRich input
result `shouldBeGolden` "mixedDirectionSimpleRTL"
it "handles simple mixed direction in LTR paragraph" $ do
let opts = defaultParagraphOptions
let input = mixedDirectionSimpleParagraph DirLTR font opts
let result = layoutRich input
result `shouldBeGolden` "mixedDirectionSimpleLTR"
it "handles complex mixed direction in RTL paragraph" $ do
let opts = defaultParagraphOptions
let input = mixedDirectionComplexParagraph DirRTL font opts
let result = layoutRich input
result `shouldBeGolden` "mixedDirectionComplexRTL"
it "handles complex mixed direction in LTR paragraph" $ do
let opts = defaultParagraphOptions
let input = mixedDirectionComplexParagraph DirLTR font opts
let result = layoutRich input
result `shouldBeGolden` "mixedDirectionComplexLTR"
it "preserves joining forms across soft breaks" $ do
let opts = defaultParagraphOptions { paragraphMaxWidth = 4500 }
let input = intraWordBreakParagraph font opts
let glyphRunsVisual = glyphRuns $ layoutRich input
let glyphRunsLogical = map reverse glyphRunsVisual
-- Glyph indexes for the corresponding Arabic letters/ligatures:
let n_initial = 407
let v_final = 971
let sh_initial = 373
let tn_final = 1363
-- Glyph index for the underscore used to break repetitions:
let sp = 89
-- Unconventional code formatting here shows that there should
-- be three repetitions of the same glyph sequence, unaffected
-- by the line break inserted after an initial form and before
-- a final form.
glyphRunsLogical `shouldBe`
[[n_initial, v_final, sh_initial, tn_final, sp,
n_initial, v_final, sh_initial], [tn_final, sp,
n_initial, v_final, sh_initial, tn_final]]
describe "paginate" $ do
let
goldenDir = ".golden" </> "paginatedRichParagraphLayout"
shouldBeGolden = goldenTest goldenDir getRichPages RichPages
describe "with Latin font" $ do
font <- runIO $ loadFont latinFont 0 testingOptions
it "wraps lorem ipsum at 20em" $ do
let opts = defaultParagraphOptions { paragraphMaxWidth = 20000 }
let input = loremIpsumParagraph font opts
let pl = layoutRich input
let popts = PageOptions
{ pageCurrentHeight = 2500
, pageNextHeight = 8500
, pageOrphans = 2
, pageWidows = 3
}
let pages = paginateAll popts pl
pages `shouldBeGolden` "loremIpsum20em"
describe "shaped runs for demo" $ do
let
goldenDir = ".golden" </> "shapedRuns"
shouldBeGolden = goldenTest goldenDir getShapedRuns ShapedRuns
-- | Test shaped runs against an expected value,
-- and write metadata about the used font afterwards.
shapedRunsSpecWithFont fontPath font subject name result = do
let infoPath = fontInfoPath goldenDir name
let writeInfo = writeFontInfo infoPath fontPath font
after_ writeInfo $ it subject $
shapedRuns result `shouldBeGolden` name
describe "with Arabic font" $ do
let fontPath = arabicFont
font <- runIO $ loadFont fontPath 0 demoOptions
let shapedRunsSpec = shapedRunsSpecWithFont fontPath font
shapedRunsSpec
"handles complex mixed direction in RTL paragraph"
"mixedDirectionComplexRTL" $
layoutRich $
mixedDirectionComplexParagraph DirRTL font $
defaultParagraphOptions
shapedRunsSpec
"preserves joining forms across soft breaks"
"intraWordBreak" $
layoutRich $
intraWordBreakParagraph font $
defaultParagraphOptions { paragraphMaxWidth = 144 }