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 -- Adding + 1 to work around rounding errors. let resultSafe = layoutRich $ input (expectedSafeWidth + 1) 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 describe "mixed line height" $ do let opts = defaultParagraphOptions { paragraphAlignment = AlignStart , paragraphMaxWidth = largeWidth } let lineHeights = (800, 1300, 1700) it "aligns to top of line" $ do let input = mixedLineHeightParagraph lineHeights AlignLineTop font opts let result = layoutRich input result `shouldBeGolden` "mixedLineHeightTop" it "aligns to bottom of line" $ do let input = mixedLineHeightParagraph lineHeights AlignLineBottom font opts let result = layoutRich input result `shouldBeGolden` "mixedLineHeightBottom" it "aligns to baseline" $ do let input = mixedLineHeightParagraph lineHeights (AlignBaseline 0) font opts let result = layoutRich input result `shouldBeGolden` "mixedLineHeightBaseline" it "aligns to baseline plus 3 units" $ do let input = mixedLineHeightParagraph lineHeights (AlignBaseline 3) font opts let result = layoutRich input result `shouldBeGolden` "mixedLineHeightBaseline3" describe "offset middle baseline" $ do -- TODO: also test interaction with line wrapping -- TODO: also test struts for inline boxes with children -- FIXME: prevent vertical trimming of paragraphs let opts = defaultParagraphOptions { paragraphAlignment = AlignStart , paragraphMaxWidth = largeWidth } it "root strut extends line downwards" $ do let input = offsetMiddleInnerTextParagraph 500 font opts let result = layoutRich input result `shouldBeGolden` "offsetMiddleUpInnerText" it "root strut extends line upwards" $ do let input = offsetMiddleInnerTextParagraph (-500) font opts let result = layoutRich input result `shouldBeGolden` "offsetMiddleDownInnerText" it "inline box strut extends line upwards" $ do let input = offsetMiddleOuterTextParagraph 500 font opts let result = layoutRich input result `shouldBeGolden` "offsetMiddleUpOuterText" it "inline box strut extends line downwards" $ do let input = offsetMiddleOuterTextParagraph (-500) font opts let result = layoutRich input result `shouldBeGolden` "offsetMiddleDownOuterText" 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 } describe "with Latin font" $ do let fontPath = latinFont font <- runIO $ loadFont latinFont 0 demoOptions let shapedRunsSpec = shapedRunsSpecWithFont fontPath font shapedRunsSpec "handles complex vertical alignment" "mixedVerticalAlignment" $ layoutRich $ mixedVerticalAlignmentParagraph font $ defaultParagraphOptions { paragraphAlignment = AlignStart , paragraphMaxWidth = largeWidth }