-- | Algorithm for finding box edges. module Data.Text.ParagraphLayout.Internal.ApplyBoxes ( WithBoxes (..) , applyBoxes ) where import Data.List.NonEmpty (NonEmpty ((:|)), (<|)) import qualified Data.List.NonEmpty as NonEmpty import Data.Text.Glyphize (Direction (DirLTR, DirRTL)) import Data.Text.ParagraphLayout.Internal.ResolvedBox import Data.Text.ParagraphLayout.Internal.ResolvedSpan import Data.Text.ParagraphLayout.Internal.WithSpan -- | Wrapper containing the original input value, -- with added information about the box edges that it touches. data WithBoxes d a = WithBoxes { leftInBoxes :: [ResolvedBox d] -- ^ Boxes whose left edge this item touches. , unwrap :: a -- ^ The original wrapped value. , rightInBoxes :: [ResolvedBox d] -- ^ Boxes whose right edge this item touches. } type Boxed d a = WithBoxes d (WithSpan d a) -- | Determine which horizontal items are the leftmost and which are the -- rightmost within their ancestor boxes. applyBoxes :: [ResolvedBox d] -- ^ Boxes open on a preceding line. Their start edge will be omitted. -> [ResolvedBox d] -- ^ Boxes open on a following line. Their end edge will be omitted. -> NonEmpty (WithSpan d a) -- ^ Box items on a given line. Must be ordered from left to right. -> NonEmpty (Boxed d a) -- ^ Box items with added information about box edges. applyBoxes prevOpen nextOpen pfs = foldr (applyBox prevOpen nextOpen) items boxes where boxes = allBoxes pfs items = fmap initBoxes pfs -- | Wrap an item in a minimal structure to be filled by the algorithm. initBoxes :: WithSpan d a -> Boxed d a initBoxes (WithSpan rs pf) = WithBoxes { leftInBoxes = [] , unwrap = WithSpan rs pf , rightInBoxes = [] } -- | Determine which horizontal item is the leftmost and which is the -- rightmost within the given ancestor box. applyBox :: [ResolvedBox d] -- ^ Boxes open on a preceding line. Their start edge will be omitted. -> [ResolvedBox d] -- ^ Boxes open on a following line. Their end edge will be omitted. -> ResolvedBox d -- ^ The box whose edges are to be determined. -> NonEmpty (Boxed d a) -- ^ Box items with partial information about box edges. -> NonEmpty (Boxed d a) -- ^ Box items with added information about edges of the given box. applyBox prevOpen nextOpen box = applyBoxEnd nextOpen box . applyBoxStart prevOpen box -- | Determine which horizontal item, if any, is the startmost -- within the given ancestor box. applyBoxStart :: [ResolvedBox d] -- ^ Boxes open on a preceding line. Their start edge will be omitted. -> ResolvedBox d -- ^ Box whose start edge should be found. -> NonEmpty (Boxed d a) -- ^ Box items with partial information about box edges. -> NonEmpty (Boxed d a) -- ^ Box items with added information about the start edge of the given box. applyBoxStart prevOpen box items | box `elem` prevOpen = items | otherwise = case boxDirection box of DirLTR -> pickBoxLeft box items DirRTL -> pickBoxRight box items _ -> items -- | Determine which horizontal item, if any, is the endmost -- within the given ancestor box. applyBoxEnd :: [ResolvedBox d] -- ^ Boxes open on a following line. Their end edge will be omitted. -> ResolvedBox d -- ^ Box whose end edge should be found. -> NonEmpty (Boxed d a) -- ^ Box items with partial information about box edges. -> NonEmpty (Boxed d a) -- ^ Box items with added information about the end edge of the given box. applyBoxEnd nextOpen box items | box `elem` nextOpen = items | otherwise = case boxDirection box of DirLTR -> pickBoxRight box items DirRTL -> pickBoxLeft box items _ -> items -- | Pick the leftmost item on the line and apply the left edge -- of the given box to it. This assumes that the box does not have -- a left edge on any other line. pickBoxLeft :: ResolvedBox d -> NonEmpty (Boxed d a) -> NonEmpty (Boxed d a) pickBoxLeft box items = updateFirst (inBox box) (addBoxLeft box) items -- | Pick the rightmost item on the line and apply the right edge -- of the given box to it. This assumes that the box does not have -- a right edge on any other line. pickBoxRight :: ResolvedBox d -> NonEmpty (Boxed d a) -> NonEmpty (Boxed d a) pickBoxRight box items = updateLast (inBox box) (addBoxRight box) items -- | Determine if the given item is contained by the given box. inBox :: ResolvedBox d -> Boxed d a -> Bool inBox box item = box `elem` boxesOf item where boxesOf (WithBoxes _ (WithSpan rs _) _) = spanBoxes rs -- | Apply the left edge of the given box to the given item. addBoxLeft :: ResolvedBox d -> Boxed d a -> Boxed d a addBoxLeft box item = item { leftInBoxes = leftInBoxes item `union` [box] } -- | Apply the right edge of the given box to the given item. addBoxRight :: ResolvedBox d -> Boxed d a -> Boxed d a addBoxRight box item = item { rightInBoxes = rightInBoxes item `union` [box] } -- | Update the first item matching the given predicate, -- or fail if none is found. updateFirst :: (a -> Bool) -> (a -> a) -> NonEmpty a -> NonEmpty a updateFirst predicate updateFunc (x :| xs) | predicate x = (updateFunc x) :| xs | otherwise = x <| updateFirst predicate updateFunc (NonEmpty.fromList xs) -- | Update the last item matching the given predicate, -- or fail if none is found. updateLast :: (a -> Bool) -> (a -> a) -> NonEmpty a -> NonEmpty a updateLast predicate updateFunc list = NonEmpty.reverse $ updateFirst predicate updateFunc $ NonEmpty.reverse list