-- | 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
-- | 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)
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)