-- | Shaping for a paragraph of plain, unidirectional text using a single font. -- -- The input text must be encoded as UTF-8 in a contiguous byte array. -- -- Positions and distances are represented as 32-bit integers. Their unit must -- be defined by the caller, who must calculate the desired dimensions of the -- EM square of the input font and set them using @hb_font_set_scale()@. For -- example, if @1em = 20px@, if the output pixels are square, and if the output -- coordinates are in 1/64ths of a pixel, you should set both the @x_scale@ and -- the @y_scale@ to @1280@. module Data.Text.ParagraphLayout.Plain (LineHeight(..) ,Paragraph(..) ,ParagraphLayout(..) ,ParagraphOptions(..) ,Rect(..) ,Span(..) ,SpanLayout(..) ,layoutPlain ) where import Data.Int (Int32) import Data.List (mapAccumL) import Data.Text.Array (Array) import Data.Text.Foreign (I8) import Data.Text.Glyphize (Buffer(..) ,ContentType(ContentTypeUnicode) ,Font ,FontExtents(..) ,GlyphInfo ,GlyphPos(x_advance) ,defaultBuffer ,fontExtentsForDir ,shape ) import Data.Text.Internal (Text(Text)) import qualified Data.Text.Lazy as Lazy import Data.Text.ParagraphLayout.Fragment import Data.Text.ParagraphLayout.LineHeight import qualified Data.Text.ParagraphLayout.ProtoFragment as PF import Data.Text.ParagraphLayout.Rect import qualified Data.Text.ParagraphLayout.ResolvedSpan as RS import Data.Text.ParagraphLayout.Run import Data.Text.ParagraphLayout.Span import Data.Text.ParagraphLayout.TextContainer -- | Text to be laid out as a paragraph. -- -- May be divided into any number of neighbouring spans, each of which will -- have its own layout rectangle(s) calculated. data Paragraph = Paragraph Array -- ^ A byte array containing the whole text to be laid out, in UTF-8. I8 -- ^ Byte offset of the first span. -- Any characters preceding this offset will not be shaped, but may still -- be used to influence the shape of neighbouring characters. [Span] -- ^ Parts of the text to be laid out, in logical order. -- The offset plus total length of all spans must not exceed array bounds. -- Any characters following the last span will not be shaped, but may still -- be used to influence the shape of neighbouring characters. ParagraphOptions -- ^ Properties applying to the paragraph as a whole. data ParagraphOptions = ParagraphOptions { paragraphFont :: Font , paragraphLineHeight :: LineHeight , paragraphMaxWidth :: Int32 } -- | The resulting layout of the whole paragraph. data ParagraphLayout = ParagraphLayout { paragraphRect :: Rect Int32 -- ^ The containing block (CSS3). , spanLayouts :: [SpanLayout] } deriving (Eq, Read, Show) -- | The resulting layout of each span, which may include multiple fragments if -- broken over multiple lines. data SpanLayout = SpanLayout [Fragment] deriving (Eq, Read, Show) -- | Wrapper for temporarily mapping the relationship to a `Span`. data WithSpan a = WithSpan RS.ResolvedSpan a instance Functor WithSpan where fmap f (WithSpan s a) = WithSpan s (f a) instance TextContainer a => TextContainer (WithSpan a) where getText (WithSpan _ c) = getText c setText t (WithSpan rs c) = WithSpan rs (setText t c) splitBySpanIndex :: [WithSpan a] -> [[a]] splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0..]] getBySpanIndex :: Int -> [WithSpan a] -> [a] getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs where matchingIndex (WithSpan rs _) = (RS.spanIndex rs) == idx contents (WithSpan _ x) = x spanRects :: SpanLayout -> [Rect Int32] spanRects (SpanLayout frags) = map fragmentRect frags base :: (Num a) => Rect a base = Rect 0 0 0 0 containRects :: (Ord a, Num a) => [Rect a] -> Rect a containRects = foldr union base -- | Interface for basic plain text layout. -- -- The entire paragraph will be assumed to have the same text direction and -- will be shaped using a single font, aligned to the left for LTR text or to -- the right for RTL text. layoutPlain :: Paragraph -> ParagraphLayout layoutPlain paragraph = ParagraphLayout pRect layouts where pRect = containRects allRects allRects = concat $ map spanRects layouts layouts = layoutSpans $ resolveSpans paragraph layoutSpans :: [RS.ResolvedSpan] -> [SpanLayout] layoutSpans spans = map SpanLayout fragsBySpan where fragsBySpan = take (length spans) $ splitBySpanIndex indexedPfs indexedPfs = layoutSingleLine $ concat $ map spanToRunsWrapped spans spanToRunsWrapped :: RS.ResolvedSpan -> [WithSpan Run] spanToRunsWrapped s = map (WithSpan s) (spanToRuns s) -- TODO: Break lines. layoutSingleLine :: [WithSpan Run] -> [WithSpan Fragment] layoutSingleLine runs = indexedFrags where indexedFrags = map (alignFragmentH originY) pfs pfs = addRunsH originX runs originX = 0 originY = 0 -- TODO: Allow a run across multiple spans (e.g. if they only differ by colour). -- | Align the given horizontal fragment vertically on a line, -- using `originY` as its bottom edge. alignFragmentH :: Int32 -> WithSpan PF.ProtoFragment -> WithSpan Fragment alignFragmentH originY (WithSpan rs pf) = WithSpan rs (Fragment rect (penX, penY) (PF.glyphs pf)) where rect = Rect (PF.offset pf) originY (PF.advance pf) lineHeight penX = 0 penY = descent + leading `div` 2 lineHeight = case RS.spanLineHeight rs of Normal -> normalLineHeight Absolute h -> h leading = lineHeight - normalLineHeight normalLineHeight = ascent + descent ascent = ascender extents descent = - descender extents extents = fontExtentsForDir font (PF.direction pf) font = RS.spanFont rs -- | Calculate layout for multiple runs on the same line, -- arrange them in one horizontal direction starting from the given x_offset. addRunsH :: Int32 -> [WithSpan Run] -> [WithSpan PF.ProtoFragment] addRunsH currentX runs = snd $ mapAccumL addRunH currentX runs -- | Calculate layout for the given run, -- place the generated fragment horizontally at the given x_offset in a line, -- and return the final x_offset for continuation. addRunH :: Int32 -> WithSpan Run -> (Int32, WithSpan PF.ProtoFragment) addRunH currentX run = (nextX, WithSpan rs pf) where WithSpan rs pf = layoutRun currentX run nextX = currentX + PF.advance pf -- | Calculate layout for the given run and position it in a line. layoutRun :: Int32 -> WithSpan Run -> WithSpan PF.ProtoFragment layoutRun originX (WithSpan rs run) = WithSpan rs pf where pf = PF.ProtoFragment dir originX totalX glyphs glyphs = shapeRun (WithSpan rs run) positions = map snd glyphs totalX = sum $ map x_advance positions dir = runDirection run -- | Calculate layout for the given run independently of its position. shapeRun :: WithSpan Run -> [(GlyphInfo, GlyphPos)] shapeRun (WithSpan rs run) = shape font buffer features where font = RS.spanFont rs -- TODO: Set beginsText / endsText. buffer = defaultBuffer { text = Lazy.fromStrict $ runText run , contentType = Just ContentTypeUnicode , direction = runDirection run , script = runScript run , language = Just $ RS.spanLanguage rs } features = [] resolveSpans :: Paragraph -> [RS.ResolvedSpan] resolveSpans (Paragraph arr off spans opts) = do let texts = cuts arr off spans let indexes = [0..] (s, t, i) <- zip3 spans texts indexes return RS.ResolvedSpan { RS.spanIndex = i , RS.spanText = t , RS.spanFont = paragraphFont opts , RS.spanLineHeight = paragraphLineHeight opts , RS.spanLanguage = spanLanguage s } -- | Produce a list of `Text`s, defined by an initial offset and a list of -- consecutive `Span`s, out of the underlying `Array`. -- -- TODO: Consider adding checks for array bounds. cuts :: Array -> I8 -> [Span] -> [Text] cuts arr initialOffset spans = snd $ mapAccumL (cut arr) initialOffset spans -- | Produce a `Text`, defined by an initial offset and a `Span`, out of the -- underlying `Array`. cut :: Array -> I8 -> Span -> (I8, Text) cut arr off s = (end, t) where len = spanLength s end = off + len t = Text arr (fromIntegral off) (fromIntegral len)