balkon-1.2.0.0: test/Data/Text/ParagraphLayout/RichSpec.hs
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.ParagraphLine (forceLeftAlign)
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
-- | A sufficiently large number to prevent line breaking,
-- while being round so that coordinates in test results are easy to read.
largeWidth :: Int32
largeWidth = 1000000000
-- | Expect two paragraph layouts to contain the same fragments,
-- except possibly shifted left or right.
shouldBeWrappedLike :: (Show d, Eq d) =>
ParagraphLayout d -> ParagraphLayout d -> Expectation
shouldBeWrappedLike a b =
forceLeftAlign a `shouldBe` forceLeftAlign b
-- | Expect two paragraph layouts to not contain the same fragments,
-- even if ignoring a possible shift to the left or to the right.
shouldNotBeWrappedLike :: (Show d, Eq d) =>
ParagraphLayout d -> ParagraphLayout d -> Expectation
shouldNotBeWrappedLike a b =
forceLeftAlign a `shouldNotBe` forceLeftAlign b
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
let commonWrapWidth = 20000
let expectedSafeWidth = 19791
describe "lorem ipsum at 20em, left aligned" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignLeft
}
let input w = loremIpsumParagraph font $
opts { paragraphMaxWidth = w }
let result20em = layoutRich $ input commonWrapWidth
let resultSafe = layoutRich $ input expectedSafeWidth
let resultUnsafe = layoutRich $ input (expectedSafeWidth - 1)
it "wraps correctly" $
result20em `shouldBeGolden` "loremIpsum20em"
it "gives correct safe width" $
paragraphSafeWidth result20em `shouldBe` expectedSafeWidth
it "wraps the same at safe width" $
resultSafe `shouldBeWrappedLike` result20em
it "does not wrap the same at smaller width" $
resultUnsafe `shouldNotBeWrappedLike` result20em
describe "lorem ipsum at 20em, right aligned" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignRight
}
let input w = loremIpsumParagraph font $
opts { paragraphMaxWidth = w }
let result20em = layoutRich $ input commonWrapWidth
let resultSafe = layoutRich $ input expectedSafeWidth
let resultUnsafe = layoutRich $ input (expectedSafeWidth - 1)
it "wraps correctly" $
result20em `shouldBeGolden` "loremIpsum20emRight"
it "gives correct safe width" $
paragraphSafeWidth result20em `shouldBe` expectedSafeWidth
it "wraps the same at safe width" $
resultSafe `shouldBeWrappedLike` result20em
it "does not wrap the same at smaller width" $
resultUnsafe `shouldNotBeWrappedLike` result20em
describe "lorem ipsum at 20em, centred" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignCentreH
}
let input w = loremIpsumParagraph font $
opts { paragraphMaxWidth = w }
let result20em = layoutRich $ input commonWrapWidth
let resultSafe = layoutRich $ input expectedSafeWidth
let resultUnsafe = layoutRich $ input (expectedSafeWidth - 1)
let resultUnsafe2 = layoutRich $ input (expectedSafeWidth - 2)
it "wraps correctly" $
result20em `shouldBeGolden` "loremIpsum20emCentre"
it "gives correct safe width" $
paragraphSafeWidth result20em `shouldBe` expectedSafeWidth
it "wraps the same at safe width" $
resultSafe `shouldBeWrappedLike` result20em
it "does not wrap the same at smaller width" $
resultUnsafe `shouldNotBeWrappedLike` result20em
-- Cover for false negatives when halving odd numbers.
it "does not wrap the same at 2 units smaller width" $
resultUnsafe2 `shouldNotBeWrappedLike` result20em
it "handles mixed line height" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let lineHeights = (800, 1300, 1700)
let input = mixedLineHeightParagraph lineHeights font opts
let result = layoutRich input
result `shouldBeGolden` "mixedLineHeight"
it "handles mixed sizes" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = mixedSizesParagraph (font, fontSmall) opts
let result = layoutRich input
result `shouldBeGolden` "mixedSizes"
it "handles mixed script" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = mixedScriptParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "mixedScript"
it "handles mixed script with line wraps" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = 5000
}
let input = mixedScriptParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "mixedScriptWrap"
it "handles empty box in the middle of the line" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = 5193
}
let input = emptyBoxParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "emptyBoxMiddle"
it "handles space box in the middle of the line" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = 4635
}
let input = spaceBoxParagraph AllowBoxCollapse font opts
let result = layoutRich input
result `shouldBeGolden` "spaceBoxMiddle"
it "can collapse space box when on its own line" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = 100
}
let input = spaceBoxParagraph AllowBoxCollapse font opts
let result = layoutRich input
result `shouldBeGolden` "spaceBoxCollapsed"
it "can preserve space box when on its own line" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = 100
}
let input = spaceBoxParagraph AvoidBoxCollapse font opts
let result = layoutRich input
result `shouldBeGolden` "spaceBoxPreserved"
it "handles nested boxes" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = nestedBoxesParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "nestedBoxes"
it "handles hard break in LTR boxes" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
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
{ paragraphAlignment = AlignStart
, 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 "makes space for one newline" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = newline1Paragraph font opts
let result = layoutRich input
result `shouldBeGolden` "newline1Paragraph"
it "makes space for one newline plus text" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = newline1TextParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "newline1TextParagraph"
it "makes space for two newlines" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = newline2Paragraph font opts
let result = layoutRich input
result `shouldBeGolden` "newline2Paragraph"
it "makes space for two newlines plus text" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = newline2TextParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "newline2TextParagraph"
it "handles hard break in RTL boxes" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = hardBoxBreakRTLParagraph font opts
let result = layoutRich input
result `shouldBeGolden` "hardBoxBreakRTL"
it "handles neutral characters in RTL paragraph" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = neutralDirectionParagraph DirRTL font opts
let result = layoutRich input
result `shouldBeGolden` "neutralDirectionRTL"
it "handles neutral characters in LTR paragraph" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
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
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
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
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
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
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
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
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = largeWidth
}
let input = mixedDirectionComplexParagraph DirLTR font opts
let result = layoutRich input
result `shouldBeGolden` "mixedDirectionComplexLTR"
it "preserves joining forms across soft breaks" $ do
let opts = defaultParagraphOptions
{ paragraphAlignment = AlignStart
, 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
{ paragraphAlignment = AlignStart
, 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
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = 640
}
shapedRunsSpec
"preserves joining forms across soft breaks"
"intraWordBreak" $
layoutRich $
intraWordBreakParagraph font $
defaultParagraphOptions
{ paragraphAlignment = AlignStart
, paragraphMaxWidth = 144
}