-- | 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