7 files changed, 191 insertions(+), 147 deletions(-)

M balkon.cabal
M lib/Data/Text/ParagraphLayout.hs
A src/Data/Text/ParagraphLayout/Internal/Paragraph.hs
M src/Data/Text/ParagraphLayout/Internal/Plain.hs
M src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs
M src/Data/Text/ParagraphLayout/Internal/Span.hs
M src/Data/Text/ParagraphLayout/Internal/TextContainer.hs

@@ 98,6 98,7 @@ library balkon-internal
         Data.Text.ParagraphLayout.Internal.Break,
         Data.Text.ParagraphLayout.Internal.Fragment,
         Data.Text.ParagraphLayout.Internal.LineHeight,
+        Data.Text.ParagraphLayout.Internal.Paragraph,
         Data.Text.ParagraphLayout.Internal.ParagraphConstruction,
         Data.Text.ParagraphLayout.Internal.Plain,
         Data.Text.ParagraphLayout.Internal.Rect,

@@ 31,5 31,6 @@ where
 
 import Data.Text.ParagraphLayout.Internal.Fragment
 import Data.Text.ParagraphLayout.Internal.LineHeight
+import Data.Text.ParagraphLayout.Internal.Paragraph
 import Data.Text.ParagraphLayout.Internal.Plain
 import Data.Text.ParagraphLayout.Internal.Span

@@ 0,0 1,110 @@
+module Data.Text.ParagraphLayout.Internal.Paragraph
+    (Paragraph(..)
+    ,ParagraphLayout(..)
+    ,ParagraphOptions(..)
+    ,paragraphLayout
+    ,paragraphOriginX
+    ,paragraphOriginY
+    ,paragraphSpanBounds
+    )
+where
+
+import Data.Int (Int32)
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
+import Data.Text.Array (Array)
+import Data.Text.Glyphize (Font)
+
+import Data.Text.ParagraphLayout.Internal.LineHeight
+import Data.Text.ParagraphLayout.Internal.Rect
+import Data.Text.ParagraphLayout.Internal.Span
+
+-- | Text to be laid out as a single paragraph.
+--
+-- May be divided into any number of neighbouring spans, each of which will
+-- be represented as a separate `SpanLayout` in the resulting layout.
+--
+-- The input text must be encoded as UTF-8 in a contiguous byte array.
+--
+-- You may need to use "Data.Text.Internal" in order to determine the byte
+-- array and the necessary offsets to construct the paragraph without copying
+-- data.
+--
+-- For simple use cases, it may be sufficient to construct paragraphs using
+-- [ParagraphConstruction]("Data.Text.ParagraphLayout.ParagraphConstruction").
+data Paragraph = Paragraph
+
+    Array
+    -- ^ A byte array containing the whole text to be laid out, in UTF-8.
+
+    Int
+    -- ^ Byte offset of the first span from the start of the byte array.
+    -- 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 initial offset plus total length of all spans must not exceed
+    -- the bounds of the byte array.
+    -- Any characters following the last span will not be shaped, but may still
+    -- be used to influence the shape of neighbouring characters.
+
+    ParagraphOptions
+    -- ^ Options applying to the paragraph as a whole.
+
+data ParagraphOptions = ParagraphOptions
+
+    { paragraphFont :: Font
+    -- ^ Font to be used for shaping and measurement.
+    -- Make sure to set its scale (see `Data.Text.Glyphize.optionScale`) using
+    -- the same units that you want in the output.
+
+    , paragraphLineHeight :: LineHeight
+    -- ^ Preferred line height of the resulting box fragments.
+
+    , paragraphMaxWidth :: Int32
+    -- ^ Line width at which line breaking should occur.
+    -- Lines will be broken at language-appropriate boundaries.
+    -- If a line still exceeds this limit then, it will be broken at character
+    -- boundaries, and if it already consists of a single cluster that cannot
+    -- be further broken down, it will overflow.
+
+    }
+    deriving (Eq, Show)
+
+-- | The resulting layout of the whole paragraph.
+data ParagraphLayout = ParagraphLayout
+    { paragraphRect :: Rect Int32
+    -- ^ The containing block (CSS3).
+    , spanLayouts :: [SpanLayout]
+    }
+    deriving (Eq, Read, Show)
+
+-- | Calculate the offsets into the `Paragraph`'s underlying `Array` where each
+-- span starts and ends, in ascending order. The resulting list will be one
+-- larger than the list of input spans.
+paragraphSpanBounds :: Paragraph -> NonEmpty Int
+paragraphSpanBounds (Paragraph _ initialOffset spans _) =
+    NonEmpty.scanl (+) initialOffset (map spanLength spans)
+
+paragraphOriginX :: (Num a) => a
+paragraphOriginX = 0
+
+paragraphOriginY :: (Num a) => a
+paragraphOriginY = 0
+
+empty :: (Num a) => Rect a
+empty = Rect
+    { x_origin = paragraphOriginX
+    , y_origin = paragraphOriginY
+    , x_size = 0
+    , y_size = 0
+    }
+
+containRects :: (Ord a, Num a) => [Rect a] -> Rect a
+containRects = foldr union empty
+
+-- | Wrap the given `SpanLayout`s and compute their containing rectangle.
+paragraphLayout :: [SpanLayout] -> ParagraphLayout
+paragraphLayout sls = ParagraphLayout pRect sls
+    where pRect = containRects $ concat $ map spanRects sls

@@ 7,17 7,16 @@ module Data.Text.ParagraphLayout.Internal.Plain
     )
 where
 
+import Control.Applicative (ZipList(ZipList), getZipList)
 import Data.Int (Int32)
 import Data.List (mapAccumL)
 import Data.List.NonEmpty (NonEmpty((:|)))
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
-import qualified Data.Text as Text
-import Data.Text.Array (Array)
 import Data.Text.Foreign (lengthWord8)
 import Data.Text.Glyphize
     (Buffer(..)
     ,ContentType(ContentTypeUnicode)
-    ,Font
     ,FontExtents(..)
     ,GlyphInfo
     ,GlyphPos(x_advance)


@@ 33,118 32,21 @@ import qualified Data.Text.Lazy as Lazy
 import Data.Text.ParagraphLayout.Internal.Break
 import Data.Text.ParagraphLayout.Internal.Fragment
 import Data.Text.ParagraphLayout.Internal.LineHeight
+import Data.Text.ParagraphLayout.Internal.Paragraph
 import qualified Data.Text.ParagraphLayout.Internal.ProtoFragment as PF
 import Data.Text.ParagraphLayout.Internal.Rect
+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.TextContainer
 
--- | Text to be laid out as a single paragraph.
---
--- May be divided into any number of neighbouring spans, each of which will
--- be represented as a separate `SpanLayout` in the resulting layout.
---
--- The input text must be encoded as UTF-8 in a contiguous byte array.
---
--- You may need to use "Data.Text.Internal" in order to determine the byte
--- array and the necessary offsets to construct the paragraph without copying
--- data.
---
--- For simple use cases, it may be sufficient to construct paragraphs using
--- [ParagraphConstruction]("Data.Text.ParagraphLayout.ParagraphConstruction").
-data Paragraph = Paragraph
-
-    Array
-    -- ^ A byte array containing the whole text to be laid out, in UTF-8.
-
-    Int
-    -- ^ Byte offset of the first span from the start of the byte array.
-    -- 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 initial offset plus total length of all spans must not exceed
-    -- the bounds of the byte array.
-    -- Any characters following the last span will not be shaped, but may still
-    -- be used to influence the shape of neighbouring characters.
-
-    ParagraphOptions
-    -- ^ Options applying to the paragraph as a whole.
-
-data ParagraphOptions = ParagraphOptions
-
-    { paragraphFont :: Font
-    -- ^ Font to be used for shaping and measurement.
-    -- Make sure to set its scale (see `Data.Text.Glyphize.optionScale`) using
-    -- the same units that you want in the output.
-
-    , paragraphLineHeight :: LineHeight
-    -- ^ Preferred line height of the resulting box fragments.
-
-    , paragraphMaxWidth :: Int32
-    -- ^ Line width at which line breaking should occur.
-    -- Lines will be broken at language-appropriate boundaries.
-    -- If a line still exceeds this limit then, it will be broken at character
-    -- boundaries, and if it already consists of a single cluster that cannot
-    -- be further broken down, it will overflow.
-
-    }
-    deriving (Eq, Show)
-
--- | 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]
-    -- TODO: Consider merging. fragments created by script changes.
-    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
-
-instance SeparableTextContainer a => SeparableTextContainer (WithSpan a) where
-    splitTextAt8 n (WithSpan rs c) = (WithSpan rs c1, WithSpan rs c2)
-        where (c1, c2) = splitTextAt8 n 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
-
 -- | Lay out a paragraph of plain, unidirectional text using a single font.
 layoutPlain :: Paragraph -> ParagraphLayout
-layoutPlain p@(Paragraph _ _ _ opts) = ParagraphLayout pRect sls
+layoutPlain p@(Paragraph _ _ _ opts) = paragraphLayout sls
     where
-        pRect = containRects $ concat $ map spanRects sls
         sls = map SpanLayout fragsBySpan
-        fragsBySpan = take (length spans) $ splitBySpanIndex frags
+        fragsBySpan = take (length spans) $ RS.splitBySpanIndex frags
         frags = layoutAndAlignLines maxWidth $ spansToRunsWrapped spans
         maxWidth = paragraphMaxWidth opts
         spans = resolveSpans p


@@ 169,7 71,7 @@ layoutAndAlignLines maxWidth runs = frags
         frags = concat fragsInLines
         (_, fragsInLines) = mapAccumL alignLineH originY protoFragsInLines
         protoFragsInLines = layoutLines maxWidth runs
-        originY = 0
+        originY = paragraphOriginY
 
 -- | Create a multi-line layout from the given runs, splitting them as
 -- necessary to fit within the requested line width.


@@ 190,7 92,7 @@ layoutLines maxWidth runs
     where
         (fitting, rest) = tryAddRunsH maxWidth originX runs
         overflowing = addRunsH originX runs
-        originX = 0
+        originX = paragraphOriginX
 
 -- TODO: Allow a run across multiple spans (e.g. if they only differ by colour).
 


@@ 272,12 174,6 @@ breakSplits closed (x:xs) = splits ++ breakSplits (x:closed) xs
         mapFunc ((x1, x2), _) =
             (reverse $ collapse $ x1 :| xs, collapse $ x2 :| closed)
 
--- | If the first run is empty, remove it.
-collapse :: NonEmpty (WithSpan Run) -> [WithSpan Run]
-collapse (x :| xs)
-    | Text.null (getText x) = xs
-    | otherwise = x:xs
-
 -- | Calculate layout for multiple runs on the same line and
 -- arrange them in one horizontal direction starting from the given x_offset.
 addRunsH :: Int32 -> [WithSpan Run] -> [WithSpan PF.ProtoFragment]


@@ 318,21 214,28 @@ shapeRun (WithSpan rs run) = shape font buffer features
         features = []
 
 resolveSpans :: Paragraph -> [RS.ResolvedSpan]
-resolveSpans p@(Paragraph arr off spans opts) = do
-    let (end, textsAndMarks) = cutsAndMarks arr off spans
-    let indexes = [0..]
-
-    (s, (o, t), i) <- zip3 spans textsAndMarks indexes
+resolveSpans p@(Paragraph arr pStart spans opts) = do
+    let sBounds = paragraphSpanBounds p
+    let pEnd = NonEmpty.last sBounds
+    let sStarts = NonEmpty.init sBounds
+    let sLengths = map spanLength spans
+
+    (i, s, sStart, sLen) <- getZipList $ (,,,)
+        <$> ZipList [0..]
+        <*> ZipList spans
+        <*> ZipList sStarts
+        <*> ZipList sLengths
     let lang = spanLanguage s
-    let breaks = paragraphLineBreaks p end lang
+    let breaks = paragraphLineBreaks p pEnd lang
     return RS.ResolvedSpan
         { RS.spanIndex = i
-        , RS.spanOffsetInParagraph = o - off
-        , RS.spanText = t
+        , RS.spanOffsetInParagraph = sStart - pStart
+        -- TODO: Consider adding checks for array bounds.
+        , RS.spanText = Text arr sStart sLen
         , RS.spanFont = paragraphFont opts
         , RS.spanLineHeight = paragraphLineHeight opts
         , RS.spanLanguage = lang
-        , RS.spanLineBreaks = subOffsetsDesc (o - off) breaks
+        , RS.spanLineBreaks = subOffsetsDesc (sStart - pStart) breaks
         }
 
 paragraphLineBreaks :: Paragraph -> Int -> String -> [(Int, BreakStatus.Line)]


@@ 358,27 261,3 @@ runLineBreaks (WithSpan rs run) = dropWhile (not . valid) $
 -- TODO: Identify and correct for differences between the two.
 localeFromLanguage :: String -> LocaleName
 localeFromLanguage x = Locale x
-
--- | Given an underlying `Array`, an initial offset, and a list of consecutive
--- `Span`s, produce a list of `Text`s corresponding to the given spans, as well
--- as the offset of the start of each `Text` and the end of the last `Text`.
---
--- TODO: Consider adding checks for array bounds.
-cutsAndMarks :: Array -> Int -> [Span] -> (Int, [(Int, Text)])
-cutsAndMarks arr initialOffset spans =
-    mapAccumL (cutAndMark arr) initialOffset spans
-
--- | Like `cut`, but also include the starting offset in the output.
-cutAndMark :: Array -> Int -> Span -> (Int, (Int, Text))
-cutAndMark arr off s = (end, (off, t))
-    where
-        (end, t) = cut arr off s
-
--- | Produce a `Text`, defined by an initial offset and a `Span`, out of the
--- underlying `Array`.
-cut :: Array -> Int -> Span -> (Int, Text)
-cut arr off s = (end, t)
-    where
-        len = spanLength s
-        end = off + len
-        t = Text arr off len

@@ 1,4 1,8 @@
-module Data.Text.ParagraphLayout.Internal.ResolvedSpan (ResolvedSpan(..))
+module Data.Text.ParagraphLayout.Internal.ResolvedSpan
+    (ResolvedSpan(..)
+    ,WithSpan(WithSpan)
+    ,splitBySpanIndex
+    )
 where
 
 import Data.Text (Text)


@@ 26,3 30,25 @@ instance Eq ResolvedSpan where
 
 instance TextContainer ResolvedSpan where
     getText = spanText
+
+-- | Wrapper for temporarily mapping the relationship to a `Span`.
+data WithSpan a = WithSpan 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
+
+instance SeparableTextContainer a => SeparableTextContainer (WithSpan a) where
+    splitTextAt8 n (WithSpan rs c) = (WithSpan rs c1, WithSpan rs c2)
+        where (c1, c2) = splitTextAt8 n 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 _) = (spanIndex rs) == idx
+        contents (WithSpan _ x) = x

@@ 1,6 1,15 @@
-module Data.Text.ParagraphLayout.Internal.Span (Span(..))
+module Data.Text.ParagraphLayout.Internal.Span
+    (Span(..)
+    ,SpanLayout(..)
+    ,spanRects
+    )
 where
 
+import Data.Int (Int32)
+
+import Data.Text.ParagraphLayout.Internal.Fragment
+import Data.Text.ParagraphLayout.Internal.Rect
+
 -- | A paragraph is broken into spans by the caller.
 --
 -- Each span could have a different font family, size, style, text decoration,


@@ 16,3 25,12 @@ data Span = Span
 
     }
     deriving (Eq, Read, Show)
+
+-- | The resulting layout of each span, which may include multiple fragments if
+-- broken over multiple lines.
+data SpanLayout = SpanLayout [Fragment]
+    -- TODO: Consider merging. fragments created by script changes.
+    deriving (Eq, Read, Show)
+
+spanRects :: SpanLayout -> [Rect Int32]
+spanRects (SpanLayout frags) = map fragmentRect frags

@@ 1,13 1,16 @@
 module Data.Text.ParagraphLayout.Internal.TextContainer
     (SeparableTextContainer
     ,TextContainer
+    ,collapse
     ,getText
     ,splitTextAt8
     ,splitTextsAt8
     )
 where
 
+import Data.List.NonEmpty (NonEmpty((:|)))
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Data.Text.Foreign (lengthWord8)
 
 -- | Class of data types containing `Text` that can be accessed.


@@ 43,3 46,9 @@ splitTextsAt8' n rpre (r:rs)
     | otherwise = let (r1, r2) = splitTextAt8 n r in (r1:rpre, r2:rs)
     where
         l = lengthWord8 $ getText r
+
+-- | If the first container in the list is empty, remove it.
+collapse :: SeparableTextContainer a => NonEmpty a -> [a]
+collapse (x :| xs)
+    | Text.null (getText x) = xs
+    | otherwise = x:xs