~jaro/balkon

fef8a026aab8152a29cb875a599f4f9e5a3ca83b — Jaro 1 year, 5 days ago ca4b08b
Refactor pagination to allow rich layout.
M src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs => src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs +54 -32
@@ 1,6 1,6 @@
-- | Splitting paragraph layouts between lines.
module Data.Text.ParagraphLayout.Internal.ParagraphLine
    ( ParagraphLine
    , cutLines
    ( cutLines
    , mergeLines
    )
where


@@ 9,52 9,75 @@ import Data.Int (Int32)
import qualified Data.List.NonEmpty as NonEmpty

import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.LinePagination
import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout
import qualified Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout as P
import Data.Text.ParagraphLayout.Internal.Rect

-- | Represents one line of a `ParagraphLayout`.
newtype ParagraphLine d = ParagraphLine (ParagraphLayout d)
class GenericLayout pl where

instance Line (ParagraphLine d) where
    lineHeight (ParagraphLine pl) = height $ paragraphRect pl
    -- | A layout with no content, to be used as an identity for appending.
    empty :: pl

-- | Split the given `ParagraphLayout` into individual lines.
cutLines :: ParagraphLayout d -> [ParagraphLine d]
    -- | Rectangle surrounding the layout, to be used for appending.
    rect :: pl -> Rect Int32

    -- | Actual distance between the paragraph origin and the nearest fragment.
    topDistance :: pl -> Int32

    -- | A list of all unique line numbers that have laid out content.
    lineNumbers :: pl -> [Int]

    -- | Keep only fragments with the given line number.
    limitFragments :: Int -> pl -> pl

    -- | Add @dy@ to each fragment's `y_origin`.
    shiftFragments :: Int32 -> pl -> pl

    -- | Combine fragments from two layouts into one,
    -- without any adjustment of coordinates.
    appendFragments :: pl -> pl -> pl

instance GenericLayout (P.ParagraphLayout d) where
    empty = P.emptyParagraphLayout
    rect = P.paragraphRect
    topDistance pl = topFragmentOrigin $ P.paragraphFragments pl
    lineNumbers pl = uniqueFragmentLines $ P.paragraphFragments pl
    limitFragments n = P.filterFragments (fragmentIsOnLine n)
    shiftFragments dy = P.mapFragments (shiftFragment dy)
    appendFragments = P.appendFragments

-- | Split the given `ParagraphLayout` into single-line layouts.
cutLines :: GenericLayout pl => pl -> [pl]
cutLines pl = map (\ n -> cutLine n pl) (lineNumbers pl)

-- | Reduce the given `ParagraphLayout` to fragments with the given line number.
cutLine :: Int -> ParagraphLayout d -> ParagraphLine d
cutLine n pl = ParagraphLine $ trimTop $ limitFragments n pl
cutLine :: GenericLayout pl => Int -> pl -> pl
cutLine n pl = trimTop $ limitFragments n pl

-- | Add a constant to each fragment's `y_origin` so that their maximum is zero.
trimTop :: ParagraphLayout d -> ParagraphLayout d
trimTop pl = shiftFragments (-top) pl
    where
        top = maximum $ map (y_origin . fragmentRect) $ paragraphFragments pl
trimTop :: GenericLayout pl => pl -> pl
trimTop pl = shiftFragments (-topDistance pl) pl

lineNumbers :: ParagraphLayout d -> [Int]
lineNumbers pl = dedupe $ map fragmentLine $ paragraphFragments pl
topFragmentOrigin :: [Fragment d] -> Int32
topFragmentOrigin frags = maximum $ map (y_origin . fragmentRect) frags

uniqueFragmentLines :: [Fragment d] -> [Int]
uniqueFragmentLines frags = dedupe $ map fragmentLine frags

-- | Remove duplicates from a sorted list.
dedupe :: Eq a => [a] -> [a]
dedupe xs = map NonEmpty.head $ NonEmpty.group xs

-- | Combine the given `ParagraphLine`s into a `ParagraphLayout` by merging
-- their fragments.
mergeLines :: [ParagraphLine d] -> ParagraphLayout d
mergeLines lls = foldl mergeLine emptyParagraphLayout lls
-- | Put the given `ParagraphLayout`s together as a vertically contiguous
-- sequence.
mergeLines :: GenericLayout pl => [pl] -> pl
mergeLines lls = foldl mergeLine empty lls

mergeLine :: ParagraphLayout d -> ParagraphLine d -> ParagraphLayout d
mergeLine pl (ParagraphLine nextLine) = pl'
mergeLine :: GenericLayout pl => pl -> pl -> pl
mergeLine pl nextLine = pl'
    where
        -- Quadratic time complexity. TODO: Consider optimising.
        pl' = appendFragments pl $ shiftFragments y nextLine
        y = y_terminus $ paragraphRect pl

-- | Add @dy@ to each fragment's `y_origin`.
shiftFragments :: Int32 -> ParagraphLayout d -> ParagraphLayout d
shiftFragments dy = mapFragments (shiftFragment dy)
        y = y_terminus $ rect pl

shiftFragment :: Int32 -> Fragment d -> Fragment d
shiftFragment dy f = f'


@@ 63,6 86,5 @@ shiftFragment dy f = f'
        r' = r { y_origin = y_origin r + dy }
        r = fragmentRect f

-- | Keep only fragments with the given line number.
limitFragments :: Int -> ParagraphLayout d -> ParagraphLayout d
limitFragments n = filterFragments ((== n) . fragmentLine)
fragmentIsOnLine :: Int -> Fragment d -> Bool
fragmentIsOnLine n frag = n == fragmentLine frag

M src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs => src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs +4 -0
@@ 13,6 13,7 @@ where
import Data.Int (Int32)

import Data.Text.ParagraphLayout.Internal.Fragment
import Data.Text.ParagraphLayout.Internal.LinePagination
import Data.Text.ParagraphLayout.Internal.ParagraphExtents
import Data.Text.ParagraphLayout.Internal.Rect
import Data.Text.ParagraphLayout.Internal.Span


@@ 25,6 26,9 @@ data ParagraphLayout d = ParagraphLayout
    }
    deriving (Eq, Read, Show)

instance Line (ParagraphLayout d) where
    lineHeight pl = height $ paragraphRect pl

-- | Wrap the given `SpanLayout`s and compute their containing rectangle.
paragraphLayout :: [SpanLayout d] -> ParagraphLayout d
paragraphLayout sls = ParagraphLayout pRect sls