From 5543d47ef77d7240841a0d14ef7df1dfba00e75c Mon Sep 17 00:00:00 2001 From: Jaro Date: Sun, 26 Feb 2023 08:34:37 +0100 Subject: [PATCH] Implement run splitting. --- balkon.cabal | 2 + src/Data/Text/ParagraphLayout/Plain.hs | 5 ++ src/Data/Text/ParagraphLayout/ResolvedSpan.hs | 5 ++ src/Data/Text/ParagraphLayout/Run.hs | 6 ++ .../Text/ParagraphLayout/TextContainer.hs | 44 ++++++++++ .../Text/ParagraphLayout/TextContainerSpec.hs | 82 +++++++++++++++++++ 6 files changed, 144 insertions(+) create mode 100644 src/Data/Text/ParagraphLayout/TextContainer.hs create mode 100644 test/Data/Text/ParagraphLayout/TextContainerSpec.hs diff --git a/balkon.cabal b/balkon.cabal index 5057890..b8c82dc 100644 --- a/balkon.cabal +++ b/balkon.cabal @@ -105,6 +105,7 @@ library Data.Text.ParagraphLayout.ResolvedSpan, Data.Text.ParagraphLayout.Run, Data.Text.ParagraphLayout.Span, + Data.Text.ParagraphLayout.TextContainer, Data.Text.Zipper -- Modules included in this library but not exported. @@ -139,6 +140,7 @@ test-suite balkon-test Data.Text.ParagraphLayout.RectSpec, Data.Text.ParagraphLayout.RunSpec, Data.Text.ParagraphLayout.SpanData, + Data.Text.ParagraphLayout.TextContainerSpec, Data.Text.ZipperSpec -- Test dependencies. diff --git a/src/Data/Text/ParagraphLayout/Plain.hs b/src/Data/Text/ParagraphLayout/Plain.hs index c432459..4f23ea6 100644 --- a/src/Data/Text/ParagraphLayout/Plain.hs +++ b/src/Data/Text/ParagraphLayout/Plain.hs @@ -45,6 +45,7 @@ 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. -- @@ -94,6 +95,10 @@ 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..]] diff --git a/src/Data/Text/ParagraphLayout/ResolvedSpan.hs b/src/Data/Text/ParagraphLayout/ResolvedSpan.hs index 110c2cf..f9f38b4 100644 --- a/src/Data/Text/ParagraphLayout/ResolvedSpan.hs +++ b/src/Data/Text/ParagraphLayout/ResolvedSpan.hs @@ -5,6 +5,7 @@ import Data.Text (Text) import Data.Text.Glyphize (Font) import Data.Text.ParagraphLayout.LineHeight +import Data.Text.ParagraphLayout.TextContainer -- | Internal structure containing resolved values that may be shared with -- other spans across the paragraph. @@ -19,3 +20,7 @@ data ResolvedSpan = ResolvedSpan instance Eq ResolvedSpan where a == b = spanIndex a == spanIndex b + +instance TextContainer ResolvedSpan where + getText = spanText + setText t s = s { spanText = t } diff --git a/src/Data/Text/ParagraphLayout/Run.hs b/src/Data/Text/ParagraphLayout/Run.hs index 38ccd99..ef7f445 100644 --- a/src/Data/Text/ParagraphLayout/Run.hs +++ b/src/Data/Text/ParagraphLayout/Run.hs @@ -9,9 +9,11 @@ import Data.Text.Script (charScript) import Data.Text.Zipper import Data.Text.ParagraphLayout.ResolvedSpan +import Data.Text.ParagraphLayout.TextContainer type ScriptCode = String + -- Each span can be broken into one or more runs by Balkón. -- -- Each run could have a different script, language, or direction. @@ -23,6 +25,10 @@ data Run = Run } deriving (Eq, Show) +instance TextContainer Run where + getText = runText + setText t r = r { runText = t } + type ProtoRun = (Zipper, Maybe Direction, ScriptCode) -- Represents a zipper that can advance by at least one character. diff --git a/src/Data/Text/ParagraphLayout/TextContainer.hs b/src/Data/Text/ParagraphLayout/TextContainer.hs new file mode 100644 index 0000000..65e49d4 --- /dev/null +++ b/src/Data/Text/ParagraphLayout/TextContainer.hs @@ -0,0 +1,44 @@ +module Data.Text.ParagraphLayout.TextContainer + (TextContainer + ,getText + ,setText + ,splitTextAt8 + ,splitTextsAt8 + ) +where + +import Data.Text (Text) +import Data.Text.Foreign (I8, dropWord8, lengthWord8, takeWord8) + +class TextContainer a where + getText :: a -> Text + setText :: Text -> a -> a + +-- | Split a text container at the given number of `Word8` units +-- from its beginning. +splitTextAt8 :: TextContainer a => I8 -> a -> (a, a) +splitTextAt8 n r = (setText text1 r, setText text2 r) + where + text1 = takeWord8 n $ getText r + text2 = dropWord8 n $ getText r + +-- | Treat a list of text containers as a contiguous sequence, +-- and make a split at the given number of `Word8` from the beginning +-- of this sequence. +-- +-- If @n@ falls on a container boundary, the total number of output containers +-- will equal the number of input containers; otherwise, it will be one larger. +splitTextsAt8 :: TextContainer a => I8 -> [a] -> ([a], [a]) +splitTextsAt8 n rs = (pre, post) + where + pre = reverse rpre + (rpre, post) = splitTextsAt8' n [] rs + +splitTextsAt8' :: TextContainer a => I8 -> [a] -> [a] -> ([a], [a]) +splitTextsAt8' _ rpre [] = (rpre, []) +splitTextsAt8' n rpre (r:rs) + | n <= 0 = (rpre, r:rs) + | n >= l = splitTextsAt8' (n - l) (r:rpre) (rs) + | otherwise = let (r1, r2) = splitTextAt8 n r in (r1:rpre, r2:rs) + where + l = fromIntegral $ lengthWord8 $ getText r diff --git a/test/Data/Text/ParagraphLayout/TextContainerSpec.hs b/test/Data/Text/ParagraphLayout/TextContainerSpec.hs new file mode 100644 index 0000000..b4cdeb8 --- /dev/null +++ b/test/Data/Text/ParagraphLayout/TextContainerSpec.hs @@ -0,0 +1,82 @@ +module Data.Text.ParagraphLayout.TextContainerSpec (spec) where + +import Data.Text (pack) +import Data.Text.Glyphize (Direction(..)) + +import Test.Hspec +import Data.Text.ParagraphLayout.Run +import Data.Text.ParagraphLayout.TextContainer + +inputRuns :: [Run] +inputRuns = + [ Run + -- TODO: We might want both parentheses in the same run. + { runText = pack "Vikipedija (" + , runDirection = Just DirLTR + , runScript = Just "Latn" + } + , Run + { runText = pack "Википедија)" + , runDirection = Just DirLTR + , runScript = Just "Cyrl" + } + ] + +spec :: Spec +spec = do + describe "splitTextsAt8" $ do + it "negative value splits at beginning of first run" $ do + splitTextsAt8 (-1) inputRuns `shouldBe` ([], inputRuns) + it "zero splits at beginning of first run" $ do + splitTextsAt8 0 inputRuns `shouldBe` ([], inputRuns) + it "splits in first run" $ do + splitTextsAt8 11 inputRuns `shouldBe` + ( + [ Run + { runText = pack "Vikipedija " + , runDirection = Just DirLTR + , runScript = Just "Latn" + } + ] + , + [ Run + { runText = pack "(" + , runDirection = Just DirLTR + , runScript = Just "Latn" + } + , Run + { runText = pack "Википедија)" + , runDirection = Just DirLTR + , runScript = Just "Cyrl" + } + ] + ) + it "split at run edges does not generate extra run" $ do + splitTextsAt8 12 inputRuns `shouldBe` + (take 1 inputRuns, drop 1 inputRuns) + it "splits in second run" $ do + splitTextsAt8 20 inputRuns `shouldBe` + ( + [ Run + { runText = pack "Vikipedija (" + , runDirection = Just DirLTR + , runScript = Just "Latn" + } + , Run + { runText = pack "Вики" + , runDirection = Just DirLTR + , runScript = Just "Cyrl" + } + ] + , + [ Run + { runText = pack "педија)" + , runDirection = Just DirLTR + , runScript = Just "Cyrl" + } + ] + ) + it "split at end does not generate extra run" $ do + splitTextsAt8 33 inputRuns `shouldBe` (inputRuns, []) + it "large value splits at end of last run" $ do + splitTextsAt8 999 inputRuns `shouldBe` (inputRuns, []) -- 2.30.2