From b27f00d9649dd8faafc91a2333818af233ea0b98 Mon Sep 17 00:00:00 2001 From: Jaro Date: Tue, 21 Feb 2023 12:04:27 +0100 Subject: [PATCH] Implement "plain" interface. --- .../golden | 12 +- .../golden | 0 balkon.cabal | 8 +- src/Data/Text/ParagraphLayout.hs | 52 +----- src/Data/Text/ParagraphLayout/Plain.hs | 146 +++++++++++---- src/Data/Text/ParagraphLayout/ResolvedSpan.hs | 14 ++ src/Data/Text/ParagraphLayout/Run.hs | 78 +++++--- src/Data/Text/ParagraphLayout/Span.hs | 17 +- src/Data/Text/Zipper.hs | 141 +++++++++++++++ .../Text/ParagraphLayout/ParagraphData.hs | 63 +++++++ test/Data/Text/ParagraphLayout/PlainSpec.hs | 28 ++- test/Data/Text/ParagraphLayout/RunSpec.hs | 4 +- test/Data/Text/ParagraphLayout/SpanData.hs | 22 +-- test/Data/Text/ParagraphLayoutSpec.hs | 41 +---- test/Data/Text/ZipperSpec.hs | 166 ++++++++++++++++++ 15 files changed, 613 insertions(+), 179 deletions(-) rename .golden/{czechHello => czechHelloParagraph}/golden (84%) rename .golden/{exampleParagraph => mixedLanguageLTRParagraph}/golden (100%) create mode 100644 src/Data/Text/ParagraphLayout/ResolvedSpan.hs create mode 100644 src/Data/Text/Zipper.hs create mode 100644 test/Data/Text/ParagraphLayout/ParagraphData.hs create mode 100644 test/Data/Text/ZipperSpec.hs diff --git a/.golden/czechHello/golden b/.golden/czechHelloParagraph/golden similarity index 84% rename from .golden/czechHello/golden rename to .golden/czechHelloParagraph/golden index f6fab29..f6145c0 100644 --- a/.golden/czechHello/golden +++ b/.golden/czechHelloParagraph/golden @@ -1,6 +1,6 @@ -[ - [ - (GlyphInfo {codepoint = 36, cluster = 0, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 663, y_advance = 0, x_offset = 0, y_offset = 0}), +ParagraphLayout {paragraphRect = Rect {x_origin = 0, y_origin = 0, x_size = 5274, y_size = 0}, spanLayouts = [ + SpanLayout [(Rect {x_origin = 0, y_origin = 0, x_size = 5274, y_size = 0}, + [(GlyphInfo {codepoint = 36, cluster = 0, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 663, y_advance = 0, x_offset = 0, y_offset = 0}), (GlyphInfo {codepoint = 75, cluster = 1, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 571, y_advance = 0, x_offset = 0, y_offset = 0}), (GlyphInfo {codepoint = 82, cluster = 2, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 590, y_advance = 0, x_offset = 0, y_offset = 0}), (GlyphInfo {codepoint = 77, cluster = 3, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 253, y_advance = 0, x_offset = 0, y_offset = 0}), @@ -11,6 +11,6 @@ (GlyphInfo {codepoint = 246, cluster = 8, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 559, y_advance = 0, x_offset = 0, y_offset = 0}), (GlyphInfo {codepoint = 87, cluster = 10, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 392, y_advance = 0, x_offset = 0, y_offset = 0}), (GlyphInfo {codepoint = 72, cluster = 11, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 559, y_advance = 0, x_offset = 0, y_offset = 0}), - (GlyphInfo {codepoint = 4, cluster = 12, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 276, y_advance = 0, x_offset = 0, y_offset = 0}) - ] -] + (GlyphInfo {codepoint = 4, cluster = 12, unsafeToBreak = False, unsafeToConcat = False, safeToInsertTatweel = False},GlyphPos {x_advance = 276, y_advance = 0, x_offset = 0, y_offset = 0})] + )] +]} diff --git a/.golden/exampleParagraph/golden b/.golden/mixedLanguageLTRParagraph/golden similarity index 100% rename from .golden/exampleParagraph/golden rename to .golden/mixedLanguageLTRParagraph/golden diff --git a/balkon.cabal b/balkon.cabal index 23ea52b..c8e1d89 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -99,8 +99,10 @@ library Data.Text.ParagraphLayout, Data.Text.ParagraphLayout.Plain, Data.Text.ParagraphLayout.Rect, + Data.Text.ParagraphLayout.ResolvedSpan, Data.Text.ParagraphLayout.Run, - Data.Text.ParagraphLayout.Span + Data.Text.ParagraphLayout.Span, + Data.Text.Zipper -- Modules included in this library but not exported. other-modules: Data.Text.Script @@ -128,10 +130,12 @@ test-suite balkon-test other-modules: Data.Text.ParagraphLayoutSpec, Data.Text.ParagraphLayout.FontLoader, + Data.Text.ParagraphLayout.ParagraphData, Data.Text.ParagraphLayout.PlainSpec, Data.Text.ParagraphLayout.RectSpec, Data.Text.ParagraphLayout.RunSpec, - Data.Text.ParagraphLayout.SpanData + Data.Text.ParagraphLayout.SpanData, + Data.Text.ZipperSpec -- Test dependencies. build-depends: diff --git a/src/Data/Text/ParagraphLayout.hs b/src/Data/Text/ParagraphLayout.hs index e7dad87..a8bbae1 100644 --- a/src/Data/Text/ParagraphLayout.hs +++ b/src/Data/Text/ParagraphLayout.hs @@ -1,52 +1,2 @@ -module Data.Text.ParagraphLayout (Span(..), layout) +module Data.Text.ParagraphLayout () where - -import Data.Text.Glyphize - (Buffer(..) - ,ContentType(ContentTypeUnicode) - ,GlyphInfo - ,GlyphPos - ,defaultBuffer - ,shape - ) - -import Data.Text.ParagraphLayout.Run -import Data.Text.ParagraphLayout.Span - -data Position = Beginning | Middle | End | Only - deriving (Eq) - --- TODO: Add maximum line length as input. --- TODO: Compute and return bounding box for each provided span. --- More if implementing the CSS Box Model. --- TODO: Also compute and return overall bounding box, in addition to individual --- ones. --- TODO: Allow a run across multiple spans (e.g. if they only differ by colour). -layout :: [Span] -> [[(GlyphInfo, GlyphPos)]] -layout = layoutRuns . concat . map spanToRuns - -layoutRuns :: [Run] -> [[(GlyphInfo, GlyphPos)]] -layoutRuns [] = [] -layoutRuns [s] = [layoutOneRun Only s] --- TODO: What if there are no visible characters in the edge runs? -layoutRuns (s1:s2:ss) = (layoutOneRun Beginning s1):(layoutRemainingRuns s2 ss) - -layoutRemainingRuns :: Run -> [Run] -> [[(GlyphInfo, GlyphPos)]] -layoutRemainingRuns s [] = [layoutOneRun End s] -layoutRemainingRuns s1 (s2:ss) = (layoutOneRun Middle s1):(layoutRemainingRuns s2 ss) - -layoutOneRun :: Position -> Run -> [(GlyphInfo, GlyphPos)] -layoutOneRun pos run = shape font buffer features - where - originalSpan = runOriginalSpan run - font = spanFont originalSpan - lang = spanLanguage originalSpan - buffer = defaultBuffer { text = runText run - , contentType = Just ContentTypeUnicode - , direction = runDirection run - , script = runScript run - , language = lang - , beginsText = pos == Beginning || pos == Only - , endsText = pos == End || pos == Only - } - features = [] diff --git a/src/Data/Text/ParagraphLayout/Plain.hs b/src/Data/Text/ParagraphLayout/Plain.hs index e881641..25e1fb2 100644 --- a/src/Data/Text/ParagraphLayout/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Plain.hs @@ -16,19 +16,30 @@ module Data.Text.ParagraphLayout.Plain ,Rect(..) ,Span(..) ,SpanLayout(..) - ,exampleParagraph ,layoutPlain ) where import Data.Int (Int32) -import Data.Text (pack) +import Data.List (mapAccumL) import Data.Text.Array (Array) import Data.Text.Foreign (I8) -import Data.Text.Glyphize (Font, GlyphInfo, GlyphPos) +import Data.Text.Glyphize + (Buffer(..) + ,ContentType(ContentTypeUnicode) + ,Font + ,GlyphInfo + ,GlyphPos(x_advance, y_advance) + ,defaultBuffer + ,shape + ) import Data.Text.Internal (Text(Text)) +import qualified Data.Text.Internal.Lazy as Lazy 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. -- @@ -67,16 +78,6 @@ data LineHeight | Relative Float -- ^ Set line height as a multiplier of the font's built-in value. -data Span = Span - - { spanLength :: I8 - -- ^ Byte offset to the next span or the end of the paragraph text. - - , spanLanguage :: String - -- ^ Used for selecting the appropriate glyphs and line breaking rules. - - } - -- | The resulting layout of the whole paragraph. data ParagraphLayout = ParagraphLayout { paragraphRect :: Rect Int32 @@ -111,26 +112,111 @@ type Box = , [(GlyphInfo, GlyphPos)] ) +boxRect :: Box -> Rect Int32 +boxRect = fst + +spanRects :: SpanLayout -> [Rect Int32] +spanRects (SpanLayout boxes) = map boxRect boxes + +base :: (Num a) => Rect a +base = Rect 0 0 0 0 + +containRects :: (Ord a, Num a) => [Rect a] -> Rect a +containRects = foldr union base + +containGlyphs :: [GlyphPos] -> Rect Int32 +containGlyphs ps = Rect + { x_origin = 0 + , y_origin = 0 + , x_size = sum $ map x_advance ps + , y_size = sum $ map y_advance ps -- TODO add line height + } + -- | 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 --- Stub implementation to make this a valid Haskell source. --- Of course, this will eventually be replaced by an actual implementation. :) -layoutPlain (Paragraph _ _ spans _) - = ParagraphLayout (Rect 0 0 0 0) (map (\_ -> SpanLayout []) spans) - -exampleArray :: Array -exampleOffset :: Int -(Text exampleArray exampleOffset _) = pack "Tak jsem tady, 世界!" - -exampleParagraph :: Font -> Paragraph -exampleParagraph font = Paragraph - exampleArray - (fromIntegral exampleOffset + 4) - [Span 11 "cs" -- this will contain the text "jsem tady, " - ,Span 7 "ja" -- this will contain the text "世界!" - ] - (ParagraphOptions font (Relative 1.5) 20000) +layoutPlain paragraph = ParagraphLayout pRect arrangedLayouts + where + pRect = containRects allRects + allRects = concat $ map spanRects arrangedLayouts + arrangedLayouts = snd $ arrangeSpansH 0 $ layouts + layouts = map layoutSpan spans + spans = resolveSpans paragraph + +-- TODO: Break lines. +-- TODO: Allow a run across multiple spans (e.g. if they only differ by colour). +layoutSpan :: RS.ResolvedSpan -> SpanLayout +layoutSpan rs = SpanLayout (map layoutRun $ spanToRuns rs) + +layoutRun :: Run -> Box +layoutRun run = (rect, glyphs) + where + rs = runOriginalSpan run + rect = containGlyphs $ map snd $ glyphs + glyphs = shape font buffer features + font = RS.spanFont rs + -- TODO: Set beginsText / endsText. + buffer = defaultBuffer + { text = 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) = map resolve $ zip spans texts + where + resolve (s, t) = RS.ResolvedSpan + { RS.spanText = t + , RS.spanFont = paragraphFont opts + , RS.spanLanguage = spanLanguage s + } + texts = cuts arr off spans + +-- | 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) + +-- | Arrange all boxes in multiple spans in one horizontal direction +-- and return the final x_offset for continuation. +arrangeSpansH :: Int32 -> [SpanLayout] -> (Int32, [SpanLayout]) +arrangeSpansH currentX sls = mapAccumL arrangeSpanH currentX sls + +-- | Arrange all boxes in one span in one horizontal direction +-- and return the final x_offset for continuation. +arrangeSpanH :: Int32 -> SpanLayout -> (Int32, SpanLayout) +arrangeSpanH currentX (SpanLayout boxes) = (nextX, SpanLayout newBoxes) + where (nextX, newBoxes) = arrangeBoxesH currentX boxes + +-- | Arrange boxes in one horizontal direction +-- and return the final x_offset for continuation. +arrangeBoxesH :: Int32 -> [Box] -> (Int32, [Box]) +arrangeBoxesH currentX boxes = mapAccumL arrangeBoxH currentX boxes + +-- | Set the horizontal offset of the given box +-- and return the x coordinate of its other side for continuation. +arrangeBoxH :: Int32 -> Box -> (Int32, Box) +arrangeBoxH currentX (rect, glyphs) = (nextX, (newRect, glyphs)) + where + nextX = currentX + x_size rect + newRect = rect { x_origin = currentX } + +fromStrict :: Text -> Lazy.Text +fromStrict t = Lazy.Chunk t Lazy.Empty diff --git a/src/Data/Text/ParagraphLayout/ResolvedSpan.hs b/src/Data/Text/ParagraphLayout/ResolvedSpan.hs new file mode 100644 index 0000000..b094176 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/ResolvedSpan.hs @@ -0,0 +1,14 @@ +module Data.Text.ParagraphLayout.ResolvedSpan (ResolvedSpan(..)) +where + +import Data.Text (Text) +import Data.Text.Glyphize (Font) + +-- | Internal structure containing resolved values that may be shared with +-- other spans across the paragraph. +data ResolvedSpan = ResolvedSpan + { spanText :: Text + , spanFont :: Font + , spanLanguage :: String + } + deriving (Eq, Show) diff --git a/src/Data/Text/ParagraphLayout/Run.hs b/src/Data/Text/ParagraphLayout/Run.hs index a360f86..736b449 100644 --- a/src/Data/Text/ParagraphLayout/Run.hs +++ b/src/Data/Text/ParagraphLayout/Run.hs @@ -1,13 +1,14 @@ module Data.Text.ParagraphLayout.Run (Run(..), spanToRuns) where +import Data.List.NonEmpty (NonEmpty((:|))) +import Data.Text (Text) import Data.Text.Glyphize (Direction(..)) import qualified Data.Text.ICU.Char as ICUChar -import Data.Text.Lazy (Text) -import qualified Data.Text.Lazy as Text import Data.Text.Script (charScript) +import Data.Text.Zipper -import Data.Text.ParagraphLayout.Span +import Data.Text.ParagraphLayout.ResolvedSpan type ScriptCode = String @@ -19,43 +20,70 @@ data Run = Run { runText :: Text , runDirection :: Maybe Direction , runScript :: Maybe ScriptCode - , runOriginalSpan :: Span + , runOriginalSpan :: ResolvedSpan } deriving (Eq, Show) -type ProtoRun = (String, Maybe Direction, ScriptCode) +type ProtoRun = (Zipper, Maybe Direction, ScriptCode) + +-- Represents a zipper that can advance by at least one character. +data ZipperChoice = ZipperChoice + { nextChar :: Char + , continuingRun :: Zipper + -- ^ The zipper will advance over the next character, + -- merging it with all preceding characters. + , startingNewRun :: Zipper + -- ^ The zipper will forget all preceding characters and then advance over + -- the next character, making it the first character in a new run of text. + } + +considerNext :: Zipper -> Maybe ZipperChoice +considerNext z = case next z of + Nothing -> Nothing + Just c -> Just ZipperChoice + { nextChar = c + , continuingRun = step z + , startingNewRun = step $ start $ following z + } data Merged a = Incompatible | Merged a --- TODO: Optimise and preserve the Data.Text.Lazy structure. -spanToRuns :: Span -> [Run] -spanToRuns s = map run $ protoRuns chars +spanToRuns :: ResolvedSpan -> [Run] +spanToRuns s = map run $ protoRuns zipper where - chars = reverse $ Text.unpack $ spanText s - run (t, d, sc) = Run - { runText = Text.pack t + zipper = start $ spanText s + run (z, d, sc) = Run + { runText = preceding z , runDirection = d , runScript = Just sc , runOriginalSpan = s } --- TODO: Try to avoid reversing. -protoRuns :: [Char] -> [ProtoRun] -protoRuns = reverse . map (\(t, d, s) -> (reverse t, d, s)) . foldr foldRun [] +protoRuns :: Zipper -> [ProtoRun] +protoRuns z = reverse $ protoRuns' z [] + +protoRuns' :: Zipper -> [ProtoRun] -> [ProtoRun] +protoRuns' curZipper curRuns = case considerNext curZipper of + Nothing -> curRuns + Just choice -> + let headRun@(nextZipper, _, _) :| tailRuns = foldRun choice curRuns + in protoRuns' nextZipper (headRun:tailRuns) + +foldRun :: ZipperChoice -> [ProtoRun] -> NonEmpty ProtoRun + +-- If there are no runs, create a new run with a single character. +foldRun x [] = (continuingRun x, d, s) :| [] + where + d = charDirection (nextChar x) + s = charScript (nextChar x) -foldRun :: Char -> [ProtoRun] -> [ProtoRun] -foldRun c [] = - -- If there are no runs, create a new run with a single character. - [([c], charDirection c, charScript c)] -foldRun c (r@(oldString, d1, s1):rs) = +foldRun x (previousRun@(_, d1, s1) : tailRuns) = case (mergeDirections d1 d2, mergeScripts s1 s2) of - -- If direction & script are compatible, add to existing run. - (Merged d, Merged s) -> ((c:oldString, d, s):rs) - -- Otherwise create a new run. - _ -> (([c], d2, s2):r:rs) + (Merged d, Merged s) -> (continuingRun x, d, s) :| tailRuns + _ -> (startingNewRun x, d2, s2) :| previousRun : tailRuns where - d2 = charDirection c - s2 = charScript c + d2 = charDirection (nextChar x) + s2 = charScript (nextChar x) -- Simplified detection of text direction for unidirectional text. mergeDirections :: Maybe Direction -> Maybe Direction -> Merged (Maybe Direction) diff --git a/src/Data/Text/ParagraphLayout/Span.hs b/src/Data/Text/ParagraphLayout/Span.hs index 6787ab9..439f22a 100644 --- a/src/Data/Text/ParagraphLayout/Span.hs +++ b/src/Data/Text/ParagraphLayout/Span.hs @@ -1,10 +1,7 @@ module Data.Text.ParagraphLayout.Span (Span(..)) where -import Data.Text.Glyphize (Font) -import Data.Text.Lazy (Text) - -type Language = String +import Data.Text.Foreign (I8) -- Paragraph is broken into spans by the caller. -- @@ -14,8 +11,12 @@ type Language = String -- TODO: Add all relevant attributes. -- data Span = Span - { spanText :: Text - , spanFont :: Font - , spanLanguage :: Maybe Language + + { spanLength :: I8 + -- ^ Byte offset to the next span or the end of the paragraph text. + + , spanLanguage :: String + -- ^ Used for selecting the appropriate glyphs and line breaking rules. + } - deriving (Eq, Show) + deriving (Show) diff --git a/src/Data/Text/Zipper.hs b/src/Data/Text/Zipper.hs new file mode 100644 index 0000000..ef0fb94 --- /dev/null +++ b/src/Data/Text/Zipper.hs @@ -0,0 +1,141 @@ +-- | Zipper API for reading text from start to end. +-- +-- All measurements are in UTF-8 code points, each of which can be between +-- 1 and 4 bytes long (inclusive). +module Data.Text.Zipper + -- TODO: Consider renaming the module to avoid conflict with text-zipper + -- from Hackage. + (Zipper(preceding, following) + ,advanceBy + ,atEnd + ,atStart + ,next + ,recombine + ,splitAt + ,start + ,step + ) +where + +import Data.Text (measureOff, null, uncons) +import Data.Text.Internal (Text(Text), empty) +import Prelude + (Bool + ,Char + ,Eq + ,Int + ,Maybe(Just, Nothing) + ,Show + ,fmap + ,fst + ,otherwise + ,(+) + ,(-) + ,(.) + ,(<=) + ,(>=) + ) + +-- | A type representing a number of UTF-8 code units, that is `Word8` units. +newtype I8 = I8 Int + +-- | Represents a body of text with a read cursor which can be moved forward. +data Zipper = Zipper { preceding :: Text, following :: Text } + deriving + ( Show + , Eq + -- ^ /O(n)/ Compare zippers by their contents. Mostly for tests. + ) + +-- | /O(1)/ Create a zipper located at the beginning of the given `Text`. +start :: Text -> Zipper +start = splitAt 0 + +-- | /O(n)/ Create a zipper located @n@ code points into the `Text`, +-- if possible, or located at the beginning or end of the `Text` otherwise. +-- +-- Similar to `Data.Text.splitAt`, except the resulting structure holds both +-- halves of the original `Text` and can be moved forward. +splitAt :: Int -> Text -> Zipper +splitAt n t + | n <= 0 = + Zipper { preceding = empty, following = t } + | otherwise = case measureI8 n t of + Just m -> + Zipper { preceding = takeWord8 m t, following = dropWord8 m t } + Nothing -> + Zipper { preceding = t, following = empty } + +-- | /O(1)/ Move the zipper forward one code point, if possible. +step :: Zipper -> Zipper +step = advanceBy 1 + +-- | /O(n)/ Move the zipper forward at most @n@ code points. +advanceBy :: Int -> Zipper -> Zipper +advanceBy n z + | n <= 0 = z + | atEnd z = z + | otherwise = case measureI8 n (following z) of + Just m -> advanceByWord8 m z + Nothing -> Zipper (recombine z) empty + +-- | /O(1)/ Produce the original `Text`. +recombine :: Zipper -> Text +recombine (Zipper t1 t2) = recombine' t1 t2 + +-- | /O(1)/ Test whether the zipper is at the start of a `Text`. +atStart :: Zipper -> Bool +atStart = null . preceding + +-- | /O(1)/ Test whether the zipper is at the end of a `Text`. +atEnd :: Zipper -> Bool +atEnd = null . following + +-- | /O(1)/ Read the next code point. +next :: Zipper -> Maybe Char +next = fmap fst . uncons . following + +-- | /O(n)/ If @t@ is long enough to contain @n@ characters, return their size +-- in `Word8`. +measureI8 :: Int -> Text -> Maybe I8 +measureI8 n t = + let m = measureOff n t in + if m >= 0 + then Just (I8 m) + else Nothing + +-- | /O(1)/ Unsafe recombination of two `Text`s. +-- +-- Requires that both `Text`s are based on the same `Array` and adjacent to +-- each other. +recombine' :: Text -> Text -> Text +recombine' (Text _ _ 0) t = t +recombine' t (Text _ _ 0) = t +recombine' (Text arr off len1) (Text _ _ len2) = Text arr off (len1 + len2) + +-- | /O(1)/ Unsafely move the zipper forward @m@ `Word8` units. +advanceByWord8 :: I8 -> Zipper -> Zipper +advanceByWord8 (I8 m) z = Zipper (recombine' a b) c + where + a = preceding z + b = takeWord8 (I8 m) (following z) + c = dropWord8 (I8 m) (following z) + +-- | /O(1)/ Unsafe version of `Data.Text.Foreign.dropWord8`. +-- +-- Return the prefix of the `Text` of @m@ `Word8` units in length. +-- +-- Requires that @m@ be within the bounds of the `Text`, not at the beginning +-- or at the end, and not inside a code point. +takeWord8 :: I8 -> Text -> Text +takeWord8 (I8 m) (Text arr off _) = Text arr off m + +-- | /O(1)/ Unsafe version of `Data.Text.Foreign.dropWord8`. +-- +-- Return the suffix of the `Text`, with @m@ `Word8` units dropped from its +-- beginning. +-- +-- Requires that @m@ be within the bounds of the `Text`, not at the beginning +-- or at the end, and not inside a code point. +dropWord8 :: I8 -> Text -> Text +dropWord8 (I8 m) (Text arr off len) = Text arr (off+m) (len-m) diff --git a/test/Data/Text/ParagraphLayout/ParagraphData.hs b/test/Data/Text/ParagraphLayout/ParagraphData.hs new file mode 100644 index 0000000..7b7d0a8 --- /dev/null +++ b/test/Data/Text/ParagraphLayout/ParagraphData.hs @@ -0,0 +1,63 @@ +module Data.Text.ParagraphLayout.ParagraphData + (czechHelloParagraph + ,emptyParagraph + ,emptySpanParagraph + ,mixedLanguageLTRParagraph + ,mixedScriptSerbianParagraph + ) +where + +import Data.Text (pack) +import Data.Text.Internal (Text(Text)) +import Data.Text.ParagraphLayout.Plain + (Paragraph(Paragraph) + ,ParagraphOptions + ,Span(Span) + ) + +emptyParagraph :: ParagraphOptions -> Paragraph +emptyParagraph opts = + let (Text arr off _) = pack "" + in Paragraph + arr + (fromIntegral off) + [] + opts + +emptySpanParagraph :: ParagraphOptions -> Paragraph +emptySpanParagraph opts = + let (Text arr off _) = pack "" + in Paragraph + arr + (fromIntegral off) + [Span 0 "en"] + opts + +czechHelloParagraph :: ParagraphOptions -> Paragraph +czechHelloParagraph opts = + let (Text arr off len) = pack "Ahoj, světe!" + in Paragraph + arr + (fromIntegral off) + [Span (fromIntegral len) "cs"] + opts + +mixedScriptSerbianParagraph :: ParagraphOptions -> Paragraph +mixedScriptSerbianParagraph opts = + let (Text arr off len) = pack "Vikipedija (Википедија)" + in Paragraph + arr + (fromIntegral off) + [Span (fromIntegral len) "sr"] + opts + +mixedLanguageLTRParagraph :: ParagraphOptions -> Paragraph +mixedLanguageLTRParagraph opts = + let (Text arr off _) = pack "Tak jsem tady, 世界!" + in Paragraph + arr + (fromIntegral off + 4) + [Span 11 "cs" -- this will contain the text "jsem tady, " + ,Span 7 "ja" -- this will contain the text "世界!" + ] + opts diff --git a/test/Data/Text/ParagraphLayout/PlainSpec.hs b/test/Data/Text/ParagraphLayout/PlainSpec.hs index 3bc0a56..8500b51 100644 --- a/test/Data/Text/ParagraphLayout/PlainSpec.hs +++ b/test/Data/Text/ParagraphLayout/PlainSpec.hs @@ -1,12 +1,14 @@ module Data.Text.ParagraphLayout.PlainSpec (spec) where import Data.List (intersperse) +import Data.Text.Glyphize (Font) import Test.Hspec import Test.Hspec.Golden import System.FilePath (()) -import Data.Text.ParagraphLayout.Plain import Data.Text.ParagraphLayout.FontLoader +import Data.Text.ParagraphLayout.ParagraphData +import Data.Text.ParagraphLayout.Plain prettyShow :: ParagraphLayout -> String prettyShow (ParagraphLayout pr sls) = showParagraphLayout where @@ -56,10 +58,28 @@ shouldBeGolden output_ name = Golden , failFirstTime = False } +emptyLayout :: ParagraphLayout +emptyLayout = ParagraphLayout (Rect 0 0 0 0) [] + +emptySpanLayout :: ParagraphLayout +emptySpanLayout = ParagraphLayout (Rect 0 0 0 0) [SpanLayout []] + +opts :: Font -> ParagraphOptions +opts font = ParagraphOptions font (Relative 1.5) 20000 + spec :: Spec spec = do -- Note: This font does not contain Japanese glyphs. describe "layoutPlain" $ before loadUbuntuRegular $ do - it "stub works" $ \font -> do - let result = layoutPlain (exampleParagraph font) - result `shouldBeGolden` "exampleParagraph" + it "handles input with no spans" $ \font -> do + let result = layoutPlain $ emptyParagraph $ opts font + result `shouldBe` emptyLayout + it "handles one span with no text" $ \font -> do + let result = layoutPlain $ emptySpanParagraph $ opts font + result `shouldBe` emptySpanLayout + it "handles Czech hello" $ \font -> do + let result = layoutPlain $ czechHelloParagraph $ opts font + result `shouldBeGolden` "czechHelloParagraph" + it "handles mixed languages in LTR layout" $ \font -> do + let result = layoutPlain $ mixedLanguageLTRParagraph $ opts font + result `shouldBeGolden` "mixedLanguageLTRParagraph" diff --git a/test/Data/Text/ParagraphLayout/RunSpec.hs b/test/Data/Text/ParagraphLayout/RunSpec.hs index 91a9458..6329ae1 100644 --- a/test/Data/Text/ParagraphLayout/RunSpec.hs +++ b/test/Data/Text/ParagraphLayout/RunSpec.hs @@ -1,11 +1,11 @@ module Data.Text.ParagraphLayout.RunSpec (spec) where +import Data.Text (pack) import Data.Text.Glyphize (Direction(..)) -import Data.Text.Lazy (pack) import Test.Hspec -import Data.Text.ParagraphLayout import Data.Text.ParagraphLayout.FontLoader +import Data.Text.ParagraphLayout.ResolvedSpan import Data.Text.ParagraphLayout.Run import Data.Text.ParagraphLayout.SpanData diff --git a/test/Data/Text/ParagraphLayout/SpanData.hs b/test/Data/Text/ParagraphLayout/SpanData.hs index f18dd39..b52a67a 100644 --- a/test/Data/Text/ParagraphLayout/SpanData.hs +++ b/test/Data/Text/ParagraphLayout/SpanData.hs @@ -5,27 +5,27 @@ module Data.Text.ParagraphLayout.SpanData ) where +import Data.Text (pack) import Data.Text.Glyphize (Font) -import Data.Text.Lazy (pack) -import Data.Text.ParagraphLayout (Span(..)) +import Data.Text.ParagraphLayout.ResolvedSpan (ResolvedSpan(..)) -emptySpan :: Font -> Span -emptySpan font = Span +emptySpan :: Font -> ResolvedSpan +emptySpan font = ResolvedSpan { spanText = pack "" , spanFont = font - , spanLanguage = Nothing + , spanLanguage = "en" } -czechHello :: Font -> Span -czechHello font = Span +czechHello :: Font -> ResolvedSpan +czechHello font = ResolvedSpan { spanText = pack "Ahoj, světe!" , spanFont = font - , spanLanguage = Just "cs" + , spanLanguage = "cs" } -serbianMixedScript :: Font -> Span -serbianMixedScript font = Span +serbianMixedScript :: Font -> ResolvedSpan +serbianMixedScript font = ResolvedSpan { spanText = pack "Vikipedija (Википедија)" , spanFont = font - , spanLanguage = Just "sr" + , spanLanguage = "sr" } diff --git a/test/Data/Text/ParagraphLayoutSpec.hs b/test/Data/Text/ParagraphLayoutSpec.hs index 2667b9c..ab6149c 100644 --- a/test/Data/Text/ParagraphLayoutSpec.hs +++ b/test/Data/Text/ParagraphLayoutSpec.hs @@ -1,45 +1,6 @@ module Data.Text.ParagraphLayoutSpec (spec) where -import Data.List (intersperse) -import Data.Text.Glyphize (GlyphInfo, GlyphPos) - import Test.Hspec -import Test.Hspec.Golden -import System.FilePath (()) -import Data.Text.ParagraphLayout -import Data.Text.ParagraphLayout.FontLoader -import Data.Text.ParagraphLayout.SpanData - -type LayoutOutput = [[(GlyphInfo,GlyphPos)]] - -prettyShow :: LayoutOutput -> String -prettyShow = showOutput - where - showOutput rs = concat ["[\n", showRuns rs, "\n]\n"] - showRuns = concat . intersperse ",\n" . map showRun - showRun gs = concat [indent1, "[\n", showGlyphs gs, "\n", indent1, "]"] - showGlyphs = concat . intersperse ",\n" . map showGlyph - showGlyph g = concat [indent2, show g] - indent1 = " " - indent2 = indent1 ++ indent1 - -shouldBeGolden :: LayoutOutput -> FilePath -> Golden LayoutOutput -shouldBeGolden output_ name = Golden - { output = output_ - , encodePretty = show - , writeToFile = \path -> writeFile path . prettyShow - , readFromFile = \path -> readFile path >>= return . read - , goldenFile = ".golden" name "golden" - , actualFile = Just (".golden" name "actual") - , failFirstTime = False - } spec :: Spec -spec = do - describe "layout" $ before loadUbuntuRegular $ do - it "handles input with no spans" $ \_ -> do - layout [] `shouldBe` [] - it "handles one span with no text" $ \font -> do - layout [emptySpan font] `shouldBe` [] - it "handles Czech hello" $ \font -> do - layout [czechHello font] `shouldBeGolden` "czechHello" +spec = return () diff --git a/test/Data/Text/ZipperSpec.hs b/test/Data/Text/ZipperSpec.hs new file mode 100644 index 0000000..6161f47 --- /dev/null +++ b/test/Data/Text/ZipperSpec.hs @@ -0,0 +1,166 @@ +module Data.Text.ZipperSpec (spec) where + +import Control.Monad (forM_) +import Data.Text (Text, empty, pack) +import qualified Data.Text as Text + +import Test.Hspec +import qualified Data.Text.Zipper as Zipper + +sampleText :: Text +sampleText = + Text.dropEnd 6 $ + Text.drop 4 $ + pack "xxx Příliš žluťoučký kůň úpěl ďábelské ódy. yyyyy" + +sampleLength :: Int +sampleLength = 39 + +midPositions :: [Int] +midPositions = [1, 2, 5, 8, 38] + +preMidPositions :: [Int] +preMidPositions = map pred midPositions + +spec :: Spec +spec = do + + describe "start on empty text" $ do + let z = Zipper.start empty + it "is at start" $ do + Zipper.atStart z `shouldBe` True + it "is at end" $ do + Zipper.atEnd z `shouldBe` True + it "has nothing preceding it" $ do + Zipper.preceding z `shouldBe` empty + it "has nothing following it" $ do + Zipper.following z `shouldBe` empty + it "has no next character" $ do + Zipper.next z `shouldBe` Nothing + it "recombines into empty text" $ do + Zipper.recombine z `shouldBe` empty + it "unchanged by step" $ do + Zipper.step z `shouldBe` z + it "unchanged by advance" $ do + Zipper.advanceBy 999 z `shouldBe` z + + describe "start" $ do + let z = Zipper.start sampleText + it "is at start" $ do + Zipper.atStart z `shouldBe` True + it "is not at end" $ do + Zipper.atEnd z `shouldBe` False + it "has nothing preceding it" $ do + Zipper.preceding z `shouldBe` empty + it "has everything following it" $ do + Zipper.following z `shouldBe` sampleText + it "has next character 'P'" $ do + Zipper.next z `shouldBe` Just 'P' + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + describe "split at zero" $ do + let z = Zipper.splitAt 0 sampleText + it "is at start" $ do + Zipper.atStart z `shouldBe` True + it "is not at end" $ do + Zipper.atEnd z `shouldBe` False + it "has nothing preceding it" $ do + Zipper.preceding z `shouldBe` empty + it "has everything following it" $ do + Zipper.following z `shouldBe` sampleText + it "has next character 'P'" $ do + Zipper.next z `shouldBe` Just 'P' + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + describe "split at negative value" $ do + let z = Zipper.splitAt (-3) sampleText + it "is at start" $ do + Zipper.atStart z `shouldBe` True + it "is not at end" $ do + Zipper.atEnd z `shouldBe` False + it "has nothing preceding it" $ do + Zipper.preceding z `shouldBe` empty + it "has everything following it" $ do + Zipper.following z `shouldBe` sampleText + it "has next character 'P'" $ do + Zipper.next z `shouldBe` Just 'P' + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + midPositions `forM_` \n -> + describe ("split at " ++ (show n)) $ do + let z = Zipper.splitAt n sampleText + it "is not at start" $ do + Zipper.atStart z `shouldBe` False + it "is not at end" $ do + Zipper.atEnd z `shouldBe` False + it ("preceding text has length " ++ show n) $ do + Text.length (Zipper.preceding z) `shouldBe` n + it ("following text has length " ++ show (sampleLength-n)) $ do + Text.length (Zipper.following z) `shouldBe` (sampleLength-n) + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + preMidPositions `forM_` \n -> + describe ("split at " ++ (show n) ++ " and step") $ do + let z = Zipper.step $ Zipper.splitAt n sampleText + it "is not at start" $ do + Zipper.atStart z `shouldBe` False + it "is not at end" $ do + Zipper.atEnd z `shouldBe` False + it ("preceding text has length " ++ show (n+1)) $ do + Text.length (Zipper.preceding z) `shouldBe` (n+1) + it ("following text has length " ++ show (sampleLength-n-1)) $ do + Text.length (Zipper.following z) `shouldBe` (sampleLength-n-1) + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + describe "start and advance by 3" $ do + let z = Zipper.advanceBy 3 $ Zipper.start sampleText + it "should be the same as splitting at 3" $ do + z `shouldBe` Zipper.splitAt 3 sampleText + it "has next character 'l'" $ do + Zipper.next z `shouldBe` Just 'l' + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + describe "split at 4 and advance by 3" $ do + let z = Zipper.advanceBy 3 $ Zipper.splitAt 4 sampleText + it "should be the same as splitting at 7" $ do + z `shouldBe` Zipper.splitAt 7 sampleText + it "has next character z-caron" $ do + Zipper.next z `shouldBe` Just 'ž' + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + describe "split past text bounds" $ do + let z = Zipper.splitAt 999 sampleText + it "is not at start" $ do + Zipper.atStart z `shouldBe` False + it "is at end" $ do + Zipper.atEnd z `shouldBe` True + it "has everything preceding it" $ do + Zipper.preceding z `shouldBe` sampleText + it "has nothing following it" $ do + Zipper.following z `shouldBe` empty + it "has no next character" $ do + Zipper.next z `shouldBe` Nothing + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText + + describe "split at 3 and advance past text bounds" $ do + let z = Zipper.advanceBy sampleLength $ Zipper.splitAt 3 sampleText + it "is not at start" $ do + Zipper.atStart z `shouldBe` False + it "is at end" $ do + Zipper.atEnd z `shouldBe` True + it "has everything preceding it" $ do + Zipper.preceding z `shouldBe` sampleText + it "has nothing following it" $ do + Zipper.following z `shouldBe` empty + it "has no next character" $ do + Zipper.next z `shouldBe` Nothing + it "recombines into original text" $ do + Zipper.recombine z `shouldBe` sampleText -- 2.30.2