module Data.Text.ParagraphLayout.RichSpec (spec) where import Data.Int (Int32) 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.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) 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 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" 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"