~jaro/balkon

ref: f72b5805e6f857d963bf025d464a86a80b9374b1 balkon/src/Data/Text/ParagraphLayout/Internal/ApplyBoxes.hs -rw-r--r-- 5.5 KiB
f72b5805Jaro Add stress test for Heisenbug hunting. 1 year, 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
-- | 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