module Data.Text.ParagraphLayout.Internal.Plain (layoutPlain) where import Control.Applicative (ZipList (ZipList), getZipList) import Data.List.NonEmpty (nonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) import Data.Text.ICU (Breaker, LocaleName, breakCharacter, breakLine) import Data.Text.ParagraphLayout.Internal.Break import Data.Text.ParagraphLayout.Internal.Layout import Data.Text.ParagraphLayout.Internal.ParagraphOptions import Data.Text.ParagraphLayout.Internal.Plain.Paragraph import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout import Data.Text.ParagraphLayout.Internal.ResolvedSpan (WithSpan (WithSpan)) import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS import Data.Text.ParagraphLayout.Internal.Run import Data.Text.ParagraphLayout.Internal.Span import Data.Text.ParagraphLayout.Internal.TextOptions -- | Lay out a paragraph of plain, unidirectional text using a single font. layoutPlain :: Paragraph d -> ParagraphLayout d layoutPlain p@(Paragraph _ _ _ opts) = paragraphLayout sls where sls = map SpanLayout fragsBySpan fragsBySpan = take (length spans) $ RS.splitBySpanIndex frags frags = case nonEmpty wrappedRuns of Just xs -> layoutAndAlignLines maxWidth xs Nothing -> [] wrappedRuns = spansToRunsWrapped spans maxWidth = paragraphMaxWidth opts spans = resolveSpans p -- | Split a number of spans into a flat array of runs and add a wrapper -- so that each run can be traced back to its originating span. spansToRunsWrapped :: [RS.ResolvedSpan d] -> [WithSpan d Run] spansToRunsWrapped ss = concat $ map spanToRunsWrapped ss -- | Split a span into runs and add a wrapper -- so that each run can be traced back to its originating span. spanToRunsWrapped :: RS.ResolvedSpan d -> [WithSpan d Run] spanToRunsWrapped s = map (WithSpan s) (spanToRuns s) resolveSpans :: Paragraph d -> [RS.ResolvedSpan d] resolveSpans p@(Paragraph _ pStart spans pOpts) = do let sBounds = paragraphSpanBounds p let sTexts = paragraphSpanTexts p let pText = paragraphText p let sStarts = NonEmpty.init sBounds (i, s, sStart, sText) <- getZipList $ (,,,) <$> ZipList [0 ..] <*> ZipList spans <*> ZipList sStarts <*> ZipList sTexts let lang = spanLanguage $ spanOptions s let lBreaks = paragraphBreaks breakLine pText lang let cBreaks = paragraphBreaks breakCharacter pText lang return RS.ResolvedSpan { RS.spanUserData = spanUserData s , RS.spanIndex = i , RS.spanOffsetInParagraph = sStart - pStart , RS.spanText = sText , RS.spanTextOptions = defaultTextOptions { textFont = paragraphFont pOpts , textLineHeight = paragraphLineHeight pOpts , textLanguage = lang } , RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) lBreaks , RS.spanCharacterBreaks = subOffsetsDesc (sStart - pStart) cBreaks } paragraphBreaks :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)] paragraphBreaks breakFunc txt lang = breaksDesc (breakFunc (locale lang LBAuto)) txt