Contents:

1. Introduction

Automatic text typesetting seems, in this day and age, a trivial matter. However, the best typesetting system available is still TeX, which was developed more than twenty years ago. Although many problems are still unsolved (good quality automatic page setting, for example: TeX is very good at splitting paragraphs into lines, but not as good at setting paragraphs into pages; also, TeX's line splitting algorithm assumes that the paragraph line width is independent from the line's position in the page, which may not be true in some page layouts), there hasn't been much advancement in this field, at least from what can be seen publicly.

Solving these issues in a general way is out of the scope of this program, unfortunately; suggestions or pointers to solutions are very welcome though, as both position-based line width and applying the total fit algorithm to page/column breaking seem a very interesting improvement to me. At this point, this program only implements the total fit algorithm for breaking a sequence of columns which have the same width; if columns don't have the same width, a simple first fit algorithm is used (because paragraphs must be broken into lines before knowing how to break lines into columns). Position based line width is also possible, but that would disable the total-fit algorithm for page/column breaking too.

This program also implements a way to automatically break a table into pages using the total fit algorithm. The width of the rows is assumed to be independent from the page they appear in, though. The algorithm in not perfect, so improvements are very welcome.

2. Overview

〈Overview〉 ≡

〈Global values〉

context [
 〈Functions used by typeset-columns and typeset-table〉
 〈Data structures and functions used by break-lines〉
 〈Functions used by typeset-columns〉
 〈Functions used by typeset-table〉

 system/words/break-lines: func [
  {Break a paragraph into lines with the total-fit algorithm}
  text-list [block!] "Paragraph contents"
  tolerance [number!] "Line stretch tolerance"
  extra-stretch [number!] "Add extra stretchability to each line"
  q [integer!] {Create this more lines with respect to the optimum solution}
  line-width [function! block! number!] "Width of lines"
  start-pos [number!] "Starting position"
  start-col [integer!] "Starting column"
  /max-lines ml [integer!] {Try to keep number of lines less than the given number}
  /verbose show-line [function!] "Be verbose (print warnings)"
  
  /local 〈break-lines' locals〉
 ] [
  ;in-func 'break-lines
  ;out-func 'break-lines (-break-text-)
  〈Break text into lines〉
 ]

 system/words/typeset-columns: func [
  "Typeset text into a number of columns"
  paragraphs [block!] "List of paragraphs"
  columns [block!] "List of columns"
  repeat-columns [block!] "List of columns to repeat"

  /local vlist
 ] [
  vlist: paras-to-vlist paragraphs columns repeat-columns
  terminate-vlist vlist
  vlist-to-columns vlist columns repeat-columns
 ]

 system/words/typeset-table: func [
  {Typeset a table of text cells into a number of pages}
  rows [block!] "List of rows"
  pages [block!] "List of pages"
  repeat-pages [block!] "List of pages to repeat"

  /local vlist 〈typeset-table's locals〉
 ] [
  vlist: table-to-vlist rows
  〈either it's possible to break the vlist into pages〉 [
   ;new-line/all vlist off
   ;new-line/skip vlist on text-list-node-size
   ;write clipboard:// mold/only vlist ask "? "
   tabvlist-to-pages vlist
  ] [
   print "??? Unable to break table into pages ???"
   [ ]
  ]
 ]
]

3. Data structures and functions used by break-lines

The break-lines function uses some data structures and functions that is useful to discuss first. (Some of these are made global to create easier decoupling between implementation and interface.)

Active nodes are created by break-lines while working; they are based on the active-node! prototype object; its fields will be discussed later.

The forblock, prev-block and next-block functions are used to abstract the handling of the text-list block; this is implemented as a flat list for memory efficiency reasons, but for conveniency it is being used like if it was a list of objects.

〈Data structures and functions used by break-lines〉 ≡

active-node!: context [
 ref: none
 line: 0
 bottom: 0
 column: 1
 fitness: 2
 totaldemerits: 0
 nlstart: 1
 ratio: 0
 prevbreak: none
 emergency-break: none
 has-next?: no
]

forblock: func [
 [throw]
 'name [word!]
 type [object!]
 list [block!]
 body [block!]
] [
 type: make type [ ]
 name: use reduce [name] reduce [to lit-word! name]
 set name type
 type/self: list
 body: bind/copy body name
 while [not tail? type/self] [
  set type type/self
  do body
  type/self: skip type/self length? next first type
 ]
]
prev-block: func [
 node [object!]
] [
 skip node/self negate length? next first node
]
next-block: func [
 node [object!]
] [
 skip node/self length? next first node
]

3.1 Global values

text-list-node!, make-text-list-node and text-list-node-size are made global so that they can be used by users of break-lines.

〈Global values〉 ≡

text-list-node!: context [
 type: 1 width: 2 stretch: 3 shrink: 4 penalty: 5 flag: 6 ratio: 7 ref: 8
 height: 9 depth: 10
]
use [tln-proto] [
 tln-proto: make text-list-node! [
  type: 'undefined
  width: stretch: shrink: penalty: flag: height: depth: 0
  ratio: ref: none
 ]
 make-text-list-node: func [spec] [
  get make tln-proto spec
 ]
]
text-list-node-words: copy next first text-list-node!
text-list-node-size: length? text-list-node-words

+infty and -infty, the positive and negative infinity, are also set global for user convenience (since they are used often). We actually need to handle different orders of infinity, and infinity math here.

〈Global values〉 +≡

〈Infinity math〉
+infty: [1 1]
+infty2: [1 2]
+infty3: [1 3]
-infty: [-1 1]

3.2 Infinity math

We need to generalize numbers to be able to handle infinite numbers of different orders. A generic number is thus represented by a block of two numbers, whose first number is the value, and whose second number is the order of infinity. Thus the usual operations can be implemented as follows:

〈Infinity math〉 ≡

add*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 case [
  a/2 = b/2 [
   a: reduce [a/1 + b/1 a/2]
   either zero? a/1 [0] [a]
  ]
  a/2 > b/2 [a]
  true [b]
 ]
]
sub*: func [a [number! block!] b [number! block!]] [
 add* a neg* b
]
neg*: func [a [number! block!]] [
 either number? a [
  negate a
 ] [
  either zero? a/1 [0] [reduce [negate a/1 a/2]]
 ]
]
mul*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 a: reduce [a/1 * b/1 a/2 + b/2]
 either zero? a/1 [0] [a]
]
div*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 a: either b/1 = 0 [
  reduce [a/1 a/2 + 1]
 ] [
  reduce [a/1 / b/1 a/2 - b/2]
 ]
 either zero? a/1 [0] [a]
]
pow*: func [a [number! block!] exp [number!]] [
 either number? a [
  power a exp
 ] [
  ; may produce curious results!
  ; we're only using it with integer exp
  a: reduce [power a/1 exp a/2 * exp]
  either zero? a/1 [0] [a]
 ]
]

We also need comparison operators:

〈Infinity math〉 +≡

eq*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 if all [zero? a/1 zero? b/1] [return true]
 a = b
]
lt*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 case [
  not-equal? sign? a/1 sign? b/1 [a/1 < b/1]
  a/2 = b/2 [a/1 < b/1]
  -1 = sign? a/1 [a/2 > b/2]
  true [a/2 < b/2]
 ]
]
gt*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 case [
  not-equal? sign? a/1 sign? b/1 [a/1 > b/1]
  a/2 = b/2 [a/1 > b/1]
  -1 = sign? a/1 [a/2 < b/2]
  true [a/2 > b/2]
 ]
]
lteq*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 case [
  not-equal? sign? a/1 sign? b/1 [a/1 < b/1]
  a/2 = b/2 [a/1 <= b/1]
  -1 = sign? a/1 [a/2 > b/2]
  true [a/2 < b/2]
 ]
]
gteq*: func [a [number! block!] b [number! block!]] [
 〈Ensure both a and b are blocks〉
 case [
  not-equal? sign? a/1 sign? b/1 [a/1 > b/1]
  a/2 = b/2 [a/1 >= b/1]
  -1 = sign? a/1 [a/2 < b/2]
  true [a/2 > b/2]
 ]
]
inf?: func [a [number! block!]] [
 either number? a [false] [a/2 > 0]
]
pos-inf?: func [a [number! block!]] [
 either number? a [false] [
  all [a/1 > 0 a/2 > 0]
 ]
]
neg-inf?: func [a [number! block!]] [
 either number? a [false] [
  all [a/1 < 0 a/2 > 0]
 ]
]

And of course, min* and max*, and abs*:

〈Infinity math〉 +≡

min*: func [a [number! block!] b [number! block!]] [
 either lt* a b [a] [b]
]
max*: func [a [number! block!] b [number! block!]] [
 either gt* a b [a] [b]
]
abs*: func [a [number! block!]] [
 either number? a [
  abs a
 ] [
  reduce [abs a/1 a/2]
 ]
]

Finally, we need to convert a generic number to a normal number:

〈Infinity math〉 +≡

to-num: func [a [number! block!]] [
 if number? a [return a]
 case [
  pos-inf? a [1E+300]
  neg-inf? a [-1E+300]
  a/2 < 0 [0]
  true [a/1]
 ]
]

3.2.1 Ensure both a and b are blocks

〈Ensure both a and b are blocks〉 ≡

if number? a [a: reduce [a 0]]
if number? b [b: reduce [b 0]]

4. Break text into lines

This is the total fit algorithm, as shown in "Breaking paragraphs into lines" by Donald E. Knuth and Michael F. Plass, originally published in Software - Practice and experience (1981) pp. 1119-1184 and republished in Digital Typography (1999) pp. 67-155. It has been modified significatly to generate underfull instead of overfull boxes in case of failure.

〈Break text into lines〉 ≡

〈Create an active node representing the starting point, initialize other values〉
;in-func 'break-lines-main-loop
forblock b text-list-node! text-list [
 〈Determine if b is a valid break〉
 if valid-break? [
  if 15 < length? active-nodes [
   sort/compare active-nodes func [a b] [lt* a/totaldemerits b/totaldemerits]
   clear skip active-nodes 15
  ]
  ;in-func 'process-active-nodes
  next-dmin: +infty
  remove-each active-node active-nodes [
   active-node/totaldemerits: sub* active-node/totaldemerits last-dmin
   next-dmin: min* active-node/totaldemerits next-dmin
   if active-node/nlstart < index? b/self [
    〈Compute the adjustment ratio r from active-node to b〉
    either gteq* r -1 [
     〈Compute demerits d and fitness class c〉
     either any [lt* r tolerance neg-inf? b/penalty] [
      〈Record a feasible break from active-node to b〉
     ] [
      〈Record as a possible emergency break for active-node〉
     ]
     neg-inf? b/penalty
    ] [
     〈Check if active-node's emergency break should be considered too〉
     true
    ]
   ]
  ]
  last-dmin: next-dmin
  ;out-func 'process-active-nodes none
  ;in-func 'create-new-active-nodes
  〈Append feasible breaks to the active-nodes list〉
  ;out-func 'create-new-active-nodes none
 ]
]
;out-func 'break-lines-main-loop none
〈Choose the active node with fewest total demerits〉
if all [ml ml < optimum/line] [
 q: ml - optimum/line
]
if q <> 0 [
 〈Choose the appropriate active node〉
]
〈Use the chosen node to determine the optimum breakpoints〉

4 break-lines' locals

〈break-lines' locals〉 ≡

valid-break? active-nodes r last-dmin next-dmin

4.1 Create an active node representing the starting point, initialize other values

〈Create an active node representing the starting point, initialize other values〉 ≡

active-nodes: append make block! 32 make active-node! [
 ref: text-list
 column: start-col
 bottom: start-pos
]
feasible-breaks: make block! 1024
fb-noline: reduce [none none none none]
fbnl-dmin: +infty
fitness-mismatch-demerits: 10000
double-hyphen-demerits: 20000
over-tolerance-demerits: 10000000000.0 ; only if it's the only way
non-justifiable-demerits: 1E+15
overfull-demerits: 100000000000.0
equal-lines: no
case [
 number? :line-width [
  equal-lines: yes
  line-width: func [lineno column bottom height depth] compose/deep [[(line-width) 1 0]]
 ]
 block? :line-width [
  line-width: func [lineno column bottom height depth] compose/deep/only [reduce [pick (line-width) lineno 1 0]]
 ]
]
last-dmin: 0

More locals:

〈break-lines' locals〉 +≡

feasible-breaks fb-noline fbnl-dmin
fitness-mismatch-demerits double-hyphen-demerits equal-lines
over-tolerance-demerits non-justifiable-demerits
overfull-demerits

4.2 Determine if b is a valid break

〈Determine if b is a valid break〉 ≡

valid-break?: switch/default b/type [
 glue [〈Is the previous node a box?〉]
 penalty [not pos-inf? b/penalty]
 kern [〈Is the next node a glue?〉]
] [no]

4.2.1 Is the previous node a box?

〈Is the previous node a box?〉 ≡

pos: prev-block b
forever [
 if head? pos [break/return false]
 switch pick pos text-list-node!/type [
  box [break/return true]
  glue [break/return false]
  penalty [break/return false]
  kern [break/return false]
 ]
 pos: skip pos negate text-list-node-size
]

More locals:

〈break-lines' locals〉 +≡

pos

4.2.2 Is the next node a glue?

〈Is the next node a glue?〉 ≡

pos: next-block b
forever [
 if tail? pos [break/return false]
 switch pick pos text-list-node!/type [
  glue [break/return true]
  box [break/return false]
  penalty [break/return false]
  kern [break/return false]
 ]
 pos: skip pos text-list-node-size
]

4.3 Compute the adjustment ratio r from active-node to b

〈Compute the adjustment ratio r from active-node to b〉 ≡

set [l stretch shrink height depth] calc-line text-list active-node/nlstart index? b/self
if b/type = 'penalty [
 l: l + b/width
 height: max height b/height
 depth: max depth b/depth
]
j: active-node/line + 1
set [lj newcol newbott] line-width j active-node/column active-node/bottom height depth
stretch: add* stretch mul* extra-stretch lj
case [
 l < lj [
  r: div* lj - l stretch
 ]
 l > lj [
  r: div* lj - l shrink
 ]
 true [r: 0]
]

More locals:

〈break-lines' locals〉 +≡

l j lj stretch shrink height depth newcol newbott

calc-line function (uses memoization, needed bounding box calculation):

〈Data structures and functions used by break-lines〉 +≡

memo-hash: make hash! [ ]
calc-line: func [text-list [block!] start [integer!] end [integer!] /local w str shr h d] [
 if start = end [return [0 0 0 0 0]]
 if w: select memo-hash as-pair start end [return w]
 end: end - text-list-node-size
 set [w str shr h d] calc-line text-list start end
 text-list: at text-list end
 switch pick text-list text-list-node!/type [
  box [
   w: w + pick text-list text-list-node!/width
   h: max h pick text-list text-list-node!/height
   d: max d pick text-list text-list-node!/depth
  ]
  kern [w: w + pick text-list text-list-node!/width]
  glue [
   w: w + pick text-list text-list-node!/width
   str: add* str pick text-list text-list-node!/stretch
   shr: shr + pick text-list text-list-node!/shrink
  ]
 ]
 insert/only insert tail memo-hash as-pair start end + text-list-node-size w: reduce [w str shr h d]
 w
]

We need to initialize memo-hash:

〈Create an active node representing the starting point, initialize other values〉 +≡

clear memo-hash

4.4 Record a feasible break from active-node to b

〈Record a feasible break from active-node to b〉 ≡

new: make active-node! [
 ref: b/self nlstart: find-next-line-start b/self
 line: j fitness: c
 column: newcol bottom: newbott
 totaldemerits: d prevbreak: active-node
 ratio: r
]
active-node/has-next?: yes
either all [equal-lines q = 0 not ml] [
 a: pick fb-noline c
 fbnl-dmin: min* fbnl-dmin d
 if better-break? a new [
  poke fb-noline c new
 ]
] [
 pos: active-node/line * 4 + c
 if pos > length? feasible-breaks [
  insert/dup tail feasible-breaks none pos - length? feasible-breaks
 ]
 a: pick feasible-breaks pos
 if better-break? a new [
  poke feasible-breaks pos new
 ]
]

More locals:

〈break-lines' locals〉 +≡

a new nlidx

find-next-line-start function:

〈Data structures and functions used by break-lines〉 +≡

find-next-line-start: func [pos] [
 forblock i text-list-node! pos [
  switch i/type [
   box [return index? i/self]
   penalty [
    if all [neg-inf? i/penalty greater? index? i/self index? pos] [return index? i/self]
   ]
  ]
 ]
 index? tail pos
]

better-break? function:

〈Data structures and functions used by break-lines〉 +≡

better-break?: func [old new] [
 any [
  none? old
  gt* old/totaldemerits new/totaldemerits
  all [
   eq* old/totaldemerits new/totaldemerits
   gt* old/ratio new/ratio
  ]
 ]
]

4.4.1 Compute demerits d and fitness class c

〈Compute demerits d and fitness class c〉 ≡

case [
 gteq* b/penalty 0 [
  d: add* mul* b/penalty b/penalty pow* add* mul* 100 pow* min* 1E+15 abs* r 3 10 2
 ]
 not neg-inf? b/penalty [
  d: sub* pow* add* mul* 100 pow* min* 1E+15 abs* r 3 10 2 mul* b/penalty b/penalty
 ]
 true [
  d: pow* add* mul* 100 pow* min* 1E+15 abs* r 3 10 2
 ]
]
; no point in going higher than this
; (a line with more than 1E15 demerits should never be chosen, unless it is the
; only possible way to break the paragraph, in which case we don't want it to
; have too many demerits because that would make the demerits of the subsequent
; lines irrelevant and thus it would not be possible to optimize them)
d: min* d 1E+15
if gteq* r tolerance [d: add* d over-tolerance-demerits]
if pos-inf? r [d: add* d non-justifiable-demerits]
if lt* r -1 [d: add* d overfull-demerits]
d: add* d double-hyphen-demerits * b/flag * pick active-node/ref text-list-node!/flag
c: case [
 lteq* r -0.5 [1]
 lteq* r 0.5 [2]
 lteq* r 1 [3]
 true [4]
]
if 1 < abs c - active-node/fitness [d: add* d fitness-mismatch-demerits]
d: add* d active-node/totaldemerits

More locals:

〈break-lines' locals〉 +≡

d c

4.5 Record as a possible emergency break for active-node

〈Record as a possible emergency break for active-node〉 ≡

new: make active-node! [
 ref: b/self
 line: j fitness: c
 column: newcol bottom: newbott
 totaldemerits: d prevbreak: active-node
 ratio: r
]
if better-break? active-node/emergency-break new [
 active-node/emergency-break: new
]

4.6 Check if active-node's emergency break should be considered too

〈Check if active-node's emergency break should be considered too〉 ≡

if all [not active-node/emergency-break not active-node/has-next?] [
 ; big emergency - record current as emergency even if r < -1
 〈Compute demerits d and fitness class c〉
 active-node/emergency-break: make active-node! [
  ref: b/self
  line: j fitness: c
  column: newcol bottom: newbott
  totaldemerits: d prevbreak: active-node
  ratio: r
 ]
]
if not active-node/has-next? [
 active-node/emergency-break/nlstart:
  find-next-line-start active-node/emergency-break/ref
 active-node: active-node/emergency-break
 〈Check if there are feasible breaks between active-node/emergency-break and b〉
]

4.6.1 Check if there are feasible breaks between active-node/emergency-break and b

〈Check if there are feasible breaks between active-node/emergency-break and b〉 ≡

add-emergency?: yes
i: b
forblock b text-list-node! skip active-node/ref text-list-node-size [
 〈Determine if b is a valid break〉
 if all [valid-break? active-node/nlstart < index? b/self] [
  〈Compute the adjustment ratio r from active-node to b〉
  if all [
   gteq* r -1
   any [lt* r tolerance neg-inf? b/penalty]
  ] [
   〈Compute demerits d and fitness class c〉
   〈Record a feasible break from active-node to b〉
  ]
  if any [neg-inf? b/penalty lt* r -1] [add-emergency?: no]
 ]
 if equal? index? b/self index? i/self [break]
]
if add-emergency? [
 〈Add active-node/emergency-break to feasible breaks too〉
]

More locals:

〈break-lines' locals〉 +≡

i add-emergency?

4.6.2 Add active-node/emergency-break to feasible breaks too

〈Add active-node/emergency-break to feasible breaks too〉 ≡

either all [equal-lines q = 0 not ml] [
 a: pick fb-noline active-node/fitness
 fbnl-dmin: min* fbnl-dmin active-node/totaldemerits
 if better-break? a active-node [
  poke fb-noline active-node/fitness active-node
 ]
] [
 pos: active-node/line - 1 * 4 + active-node/fitness
 if pos > length? feasible-breaks [
  insert/dup tail feasible-breaks none pos - length? feasible-breaks
 ]
 a: pick feasible-breaks pos
 if better-break? a active-node [
  poke feasible-breaks pos active-node
 ]
]

4.7 Append feasible breaks to the active-nodes list

〈Append feasible breaks to the active-nodes list〉 ≡

either all [equal-lines q = 0 not ml] [
 parse fb-noline [some [
  none!
  |
  feasible-break: object! (
   if gt* add* fbnl-dmin fitness-mismatch-demerits feasible-break/1/totaldemerits [
    append active-nodes feasible-break/1
   ]
   feasible-break/1: none
  )
 ]]
 fbnl-dmin: +infty
] [
 dmin: +infty
 parse feasible-breaks [some [
  4 none!
  |
  pos: 1 4 [
   none!
   |
   set feasible-break object! (dmin: min* feasible-break/totaldemerits dmin)
  ]
  :pos
  1 4 [
   none!
   |
   feasible-break: object! (
    if gt* add* dmin fitness-mismatch-demerits feasible-break/1/totaldemerits [
     append active-nodes feasible-break/1
    ]
    feasible-break/1: none
   )
  ] (dmin: +infty)
 ]]
]

More locals:

〈break-lines' locals〉 +≡

feasible-break dmin

4.8 Choose the active node with fewest total demerits

〈Choose the active node with fewest total demerits〉 ≡

d: +infty
optimum: none
foreach final-node active-nodes [
 if lt* final-node/totaldemerits d [
  d: final-node/totaldemerits
  optimum: final-node
 ]
]

More locals:

〈break-lines' locals〉 +≡

optimum

4.9 Choose the appropriate active node

〈Choose the appropriate active node〉 ≡

s: 0
lines: optimum/line
foreach final-node active-nodes [
 delta: final-node/line - lines
 case [
  any [
   all [q <= delta delta < s]
   all [s < delta delta <= q]
  ] [
   s: delta
   d: final-node/totaldemerits
   optimum: final-node
  ]
  all [delta = s lt* final-node/totaldemerits d] [
   d: final-node/totaldemerits
   optimum: final-node
  ]
 ]
]

More locals:

〈break-lines' locals〉 +≡

s delta lines

4.10 Use the chosen node to determine the optimum breakpoints

〈Use the chosen node to determine the optimum breakpoints〉 ≡

if tmp: optimum [
 until [
  either tmp/prevbreak [
   if all [
    any [
     gteq* tmp/ratio tolerance
     lt* tmp/ratio -1
    ]
    verbose
   ] [
    case [
     inf? tmp/ratio [
      print {Warning: line/column is not stretchable, cannot justify.}
     ]
     lt* tmp/ratio -1 [
      print ["Warning: overfull line/column."]
     ]
     true [
      print [
       "Warning: line/column above tolerance (ratio:"
       to-num tmp/ratio ", tolerance:" tolerance ")."
      ]
     ]
    ]
    show-line tmp/prevbreak/ref tmp/ref
   ]
   poke tmp/prevbreak/ref text-list-node!/ratio tmp/ratio
   tmp: tmp/prevbreak
   false
  ] [
   true
  ]
 ]
]
optimum

More locals:

〈break-lines' locals〉 +≡

tmp

5. typeset-columns and typeset-table

This section covers the two functions typeset-columns and typeset-table.

5.1 typeset-table's code

5.1.1 either it's possible to break the vlist into pages

〈either it's possible to break the vlist into pages〉 ≡

append vlist make-text-list-node [type: 'row ref: none]
terminate-vlist vlist
page-height: func [page column bottom height depth] [
 height: pick-page pages repeat-pages page
 either height [
  reduce [height 1 0]
 ] [
  reduce [1E+100 1 0]
 ]
]
either break-lines vlist 2 0 0 :page-height 0 1

5.1.2 typeset-table's locals

〈typeset-table's locals〉 ≡

page-height

5.2 Functions used by typeset-columns and typeset-table

〈Functions used by typeset-columns and typeset-table〉 ≡

terminate-vlist: func [vlist] [
 ; do not allow break before the infinite stretch
 vlist: tail vlist
 while [
  all [
   not head? vlist
   'box <> pick vlist text-list-node!/type - 1 - text-list-node-size
  ]
 ] [
  vlist: skip vlist negate text-list-node-size
 ]
 insert vlist make-text-list-node [type: 'penalty penalty: +infty]
 insert insert tail vlist
  make-text-list-node [type: 'glue stretch: +infty]
  make-text-list-node [type: 'penalty penalty: -infty]
]
paras-to-vlist: func [paragraphs columns repeat-columns /local 〈paras-to-vlist's locals〉] [
 〈Build a vertical list for the paragraphs〉
]
vlist-to-columns: func [vlist columns repeat-columns /local 〈vlist-to-cols' locals〉] [
 〈Typeset a vlist into columns〉
]
table-to-vlist: func [rows /local 〈table-to-vlist's locals〉] [
 〈Convert a table to a vertical list〉
]
tabvlist-to-pages: func [vlist /with sr ss /local 〈tabvlist-to-pages' locals〉] [
 〈Split a table into pages, using the results of break-lines〉
]

5.3 Build a vertical list for the paragraphs

〈Build a vertical list for the paragraphs〉 ≡

〈Inititalize values〉
foreach para paragraphs [
 switch para/type [
  paragraph [
   interline-glue: pick para/interline-glue text-list-node!/width
   para-margins: para/margins
   line-width: either all [asw? 1 = length? para-margins] [
    asw? - margin para-margins 1
   ] [
    :line-width-func
   ]
   either 〈break-lines can find line breaks for the paragraph〉 [
    〈Typeset the paragraph based on the results of break-lines〉
   ] [
    print "??? Unable to break paragraph into lines ???"
   ]
  ]
  vspace [
   〈Add vertical space〉
  ]
  vpenalty [
   append output make-text-list-node [
    type: 'penalty
    penalty: para/penalty
   ]
   if neg-inf? para/penalty [
    prev/bottom: 0
    prev/column: prev/column + 1
    prev/type: 'space
   ]
  ]
  table [
   〈Add the table to output〉
  ]
  vbox [
   〈Add vertical box〉
  ]
 ]
]
output

5.3.1 paras-to-vlist's locals

〈paras-to-vlist's locals〉 ≡

interline-glue para-margins prev output line-width
asw? line-width-func

5.3.2 break-lines can find line breaks for the paragraph

〈break-lines can find line breaks for the paragraph〉 ≡

optimum: break-lines/verbose para/contents para/tolerance para/extra-stretch para/looseness :line-width
 either prev/type = 'line [prev/bottom + interline-glue] [prev/bottom]
 prev/column :show-line

Other locals:

〈paras-to-vlist's locals〉 +≡

optimum

5.3.3 Inititalize values

〈Inititalize values〉 ≡

asw?: all-same-width? join columns repeat-columns
line-width-func: either asw? [
 func [line column bottom height depth] [
  reduce [asw? - margin para-margins line 1 0]
 ]
] [
 func [line column bottom height depth /local colw colh] [
  set [colw colh] pick-column columns repeat-columns column
  if not colw [
   set [colw colh] pick-column columns repeat-columns column - 1
   colh: 1E+300
  ]
  bottom: bottom + interline-glue + height + depth
  either bottom <= colh [
   reduce [colw - margin para-margins line column bottom]
  ] [
   if colh: pick-column columns repeat-columns column: column + 1 [
    set [colw colh] colh
   ]
   reduce [colw - margin para-margins line column height + depth]
  ]
 ]
]
commands: make block! 16
prev: context [type: 'space bottom: 0 column: 1]
output: make block! 1024

More locals:

〈paras-to-vlist's locals〉 +≡

commands

5.3.4 Typeset the paragraph based on the results of break-lines

〈Typeset the paragraph based on the results of break-lines〉 ≡

lineno: 1
typeset-text-list/rlimit para/contents func [type value] [
 switch type [
  box [
   ; value: [char width height depth]
   either block? value/1 [
    repend line ['box line/1 value/2 value/3 value/4 value/1]
   ] [
    either string? word: pick tail line -1 [
     append word value/1
    ] [
     insert tail line word: make string! 32
     insert word value/1
    ]
   ]
   line/1: line/1 + value/2
   line/2: max line/2 value/3
   line/3: max line/3 value/4
  ]
  glue [
   ; value: [width]
   insert tail line value/1
   line/1: line/1 + value/1
  ]
  cmd [
   insert tail line value
   set-cmd commands value
  ]
 ]
] does [
 〈Append previous line to output〉
 insert insert line: make block! 256 [0 0 0 0] get-cmd commands
] either para/align = 'justify [+infty] [0]
〈Append previous line to output〉
line: none

More locals:

〈paras-to-vlist's locals〉 +≡

word line tmp lineno

5.3.5 Add vertical space

〈Add vertical space〉 ≡

either asw? [
 〈Append glue to output〉
] [
 set [colw colh] pick-column columns repeat-columns prev/column
 either inf? para/stretch [
  either colw [
   prev/bottom: 0
   prev/column: prev/column + 1
   prev/type: 'space
   〈Append glue to output〉
   if all [
    tmp: pick-column columns repeat-columns prev/column
    colw <> tmp/1
   ] [
    append output make-text-list-node [
     type: 'penalty
     penalty: -infty
    ]
   ]
  ] [
   〈Append glue to output〉
  ]
 ] [
  if not colw [
   colh: 1E+300
  ]
  prev/bottom: prev/bottom + para/height
  either prev/bottom > colh [
   prev/column: prev/column + 1
   prev/bottom: 0
   either all [
    tmp: pick-column columns repeat-columns prev/column
    colw <> tmp/1
   ] [
    insert insert tail output
     make-text-list-node [type: 'glue stretch: add* para/height para/stretch]
     make-text-list-node [type: 'penalty penalty: -infty]
    prev/type: 'space
   ] [
    〈Append glue to output〉
   ]
  ] [
   〈Append glue to output〉
  ]
 ]
]

More locals:

〈paras-to-vlist's locals〉 +≡

colw colh

5.3.6 Add vertical box

〈Add vertical box〉 ≡

either asw? [
 append output make-text-list-node [
  type: 'box
  width: para/height
  ref: reduce ['box asw? para/height para/contents]
 ]
] [
 set [colw colh] pick-column columns repeat-columns prev/column
 if not colw [
  colh: 1E+300
 ]
 prev/bottom: prev/bottom + para/height
 either prev/bottom > colh [
  prev/column: prev/column + 1
  prev/bottom: para/height
  either all [
   tmp: pick-column columns repeat-columns prev/column
   colw <> tmp/1
  ] [
   insert insert insert tail output
    make-text-list-node [type: 'glue stretch: para/height]
    make-text-list-node [type: 'penalty penalty: -infty]
    make-text-list-node [
     type: 'box width: para/height
     ref: reduce ['box tmp/1 para/height para/contents]
    ]
  ] [
   append output make-text-list-node [
    type: 'box
    width: para/height
    ref: reduce ['box colw para/height para/contents]
   ]
  ]
 ] [
  append output make-text-list-node [
   type: 'box
   width: para/height
   ref: reduce ['box colw para/height para/contents]
  ]
 ]
]
prev/type: 'line

5.3.7 Add the table to output

〈Add the table to output〉 ≡

insert insert insert tail output
 make-text-list-node [type: 'table-start]
 tmp: table-to-vlist para/rows
 make-text-list-node [type: 'table-end]
if not asw? [
 ; this won't be accurate
 print {Warning: using embedded table in variable width columns.}
 foreach :text-list-node-words tmp [
  set [colw colh] pick-column columns repeat-columns prev/column
  if not colw [
   colh: 1E+300
  ]
  prev/bottom: prev/bottom + width
  if prev/bottom > colh [
   prev/column: prev/column + 1
   ; this is not really correct
   prev/bottom: 0
  ]
 ]
]
prev/type: 'space ; table ends with space

5.3.8 Append glue to output

〈Append glue to output〉 ≡

append output make-text-list-node [
 type: 'glue
 width: para/height
 stretch: para/stretch
 shrink: para/shrink
]
prev/type: 'space

5.3.9 Append previous line to output

〈Append previous line to output〉 ≡

if line [
 either asw? [
  〈All columns have the same width〉
 ] [
  〈The columns have variable width〉
 ]
 lineno: lineno + 1
]

5.3.10 All columns have the same width

〈All columns have the same width〉 ≡

either optimum/line > 3 [
 case [
  lineno = 2 [
   append output make-text-list-node [type: 'penalty penalty: 500]
  ]
  lineno = 3 [
   append output make-text-list-node [type: 'penalty penalty: 200]
  ]
  optimum/line = lineno [
   append output make-text-list-node [type: 'penalty penalty: 500]
  ]
  optimum/line - 1 = lineno [
   append output make-text-list-node [type: 'penalty penalty: 200]
  ]
 ]
] [
 switch optimum/line [
  2 [
   if lineno = 2 [
    append output make-text-list-node [type: 'penalty penalty: 1000]
   ]
  ]
  3 [
   if lineno <> 1 [
    append output make-text-list-node [type: 'penalty penalty: 500]
   ]
  ]
 ]
]
switch para/align [
 center [line/4: add divide asw? - line/1 - margin para/margins lineno 2 lmargin para/margins lineno]
 right [line/4: asw? - line/1 - rmargin para/margins lineno]
 left [line/4: lmargin para/margins lineno]
 justify [line/4: lmargin para/margins lineno]
]
if prev/type = 'line [append output para/interline-glue]
append output make-text-list-node [
 type: 'box
 width: line/2 + line/3
 ref: line
]
prev/type: 'line

5.3.11 The columns have variable width

〈The columns have variable width〉 ≡

set [colw colh] pick-column columns repeat-columns prev/column
if not colw [
 set [colw colh] pick-column columns repeat-columns prev/column - 1
 colh: 1E+300
]
switch para/align [
 center [line/4: add divide colw - line/1 - margin para/margins lineno 2 lmargin para/margins lineno]
 right [line/4: colw - line/1 - rmargin para/margins lineno]
 left [line/4: lmargin para/margins lineno]
 justify [line/4: lmargin para/margins lineno]
]
prev/bottom: prev/bottom + line/2 + line/3
 + either prev/type = 'line [interline-glue] [0]
either prev/bottom > colh [
 prev/column: prev/column + 1
 prev/bottom: line/2 + line/3
 either all [
  tmp: pick-column columns repeat-columns prev/column
  colw <> tmp/1
 ] [
  append output make-text-list-node [
   type: 'penalty
   penalty: -infty
  ]
 ] [
  if prev/type = 'line [append output para/interline-glue]
 ]
] [
 if prev/type = 'line [append output para/interline-glue]
]
append output make-text-list-node [
 type: 'box
 width: line/2 + line/3
 ref: line
]
prev/type: 'line

5.4 Typeset a vlist into columns

〈Typeset a vlist into columns〉 ≡

cols: func [line column bottom height depth /local colw colh] [
 set [colw colh] pick-column columns repeat-columns line
 either colh [
  reduce [colh 1 0]
 ] [
  reduce [1E+100 1 0]
 ]
]
optimum: either empty? repeat-columns [
 break-lines/verbose/max-lines vlist 2 0 0 :cols 0 1 :show-col divide length? columns 2
] [
 break-lines/verbose vlist 2 0 0 :cols 0 1 :show-col
]
either optimum [
 result: make block! 16
 typeset-text-list/rlimit vlist func [type value] [
  switch type [
   box [
    ; value: [line height 0 0]
    insert/only tail column value/1
   ]
   glue [
    ; value: [height]
    insert tail column value/1
   ]
   cmd [
    insert tail column value
   ]
   table [
    foreach page value [
     insert/only insert tail column 'table page
     insert/only tail result column: make block! 256
    ]
    remove back tail result
    column: last result
   ]
  ]
 ] does [
  insert/only tail result column: make block! 256
 ] 1
 result
] [
 print "??? Unable to break lines into columns ???"
 [ ]
]

5.4.1 vlist-to-cols' locals

〈vlist-to-cols' locals〉 ≡

result column cols optimum

5.5 Functions used by typeset-columns

〈Functions used by typeset-columns〉 ≡

all-same-width?: func [columns /local w] [
 w: first columns
 foreach [width height] skip columns 2 [
  if w <> width [return none]
 ]
 w
]
pick-column: func [columns repeat-columns column /local cols rcols] [
 cols: divide length? columns 2
 rcols: divide length? repeat-columns 2
 column: column - 1
 either column >= cols [
  if zero? rcols [return none]
  column: column - cols // rcols
  copy/part skip repeat-columns column * 2 2
 ] [
  copy/part skip columns column * 2 2
 ]
]
make-cols: func [columns repeat-columns cols /local] [
 local: make block! 16
 foreach [colw colh] columns [
  append local colh
  cols: cols - 1
  if zero? cols [return append local 1E+100]
 ]
 if empty? repeat-columns [return append local 1E+100]
 forever [
  foreach [colw colh] repeat-columns [
   append local colh
   cols: cols - 1
   if zero? cols [return append local 1E+100]
  ]
 ]
]
set-cmd: func [commands cmd /local] [
 either local: find commands cmd/1 [
  local/2: cmd
 ] [
  insert/only insert tail commands cmd/1 cmd
 ]
]
get-cmd: func [commands /local res] [
 ; no copy!
 res: clear [ ]
 foreach [name cmd] commands [
  append res cmd
 ]
 res
]
show-col: func [start end] [
 while ['box <> pick start text-list-node!/type] [
  start: skip start text-list-node-size
 ]
 end: skip end negate text-list-node-size
 while ['box <> pick end text-list-node!/type] [
  end: skip end negate text-list-node-size
 ]
 start: pick start text-list-node!/ref
 end: pick end text-list-node!/ref
 print ["Column from" mold start "to" mold end]
]
show-line: func [start end /local ln] [
 while ['box <> pick start text-list-node!/type] [
  start: skip start text-list-node-size
 ]
 ln: clear ""
 while [lesser? index? start index? end] [
  switch pick start text-list-node!/type [
   box [append ln pick start text-list-node!/ref]
   glue [append ln " "]
  ]
  start: skip start text-list-node-size
 ]
 print ["Line" mold ln]
]
margins?: func [margins line] [
 any [pick margins line last margins]
]
lmargin: func [margins line] [
 line: margins? margins line
 line/1
]
rmargin: func [margins line] [
 line: margins? margins line
 line/2
]
margin: func [margins line] [
 line: margins? margins line
 line/1 + line/2
]

5.6 Other functions used by typeset-columns and typeset-table

〈Functions used by typeset-columns and typeset-table〉 +≡

typeset-text-list: func [text-list emit newline /rlimit rl /with sr ss /local skip? r tabend table] [
 newline
 unless rlimit [rl: +infty]
 if sr [
  r: get sr
  skip?: get ss
 ]
 forblock b text-list-node! text-list [
  if not r [r: max* -1 min* b/ratio rl b/ratio: none]
  switch b/type [
   box [
    skip?: no
    emit 'box reduce [b/ref b/width b/height b/depth]
   ]
   glue [
    if not skip? [
     either b/ratio [
      r: max* -1 min* b/ratio rl
      skip?: yes
      newline
     ] [
      emit 'glue reduce [
       b/width + to-num either lt* r 0 [mul* b/shrink r] [mul* b/stretch r]
       b/ref
      ]
     ]
    ]
   ]
   kern [
    if not skip? [
     either b/ratio [
      r: max* -1 min* b/ratio rl
      skip?: yes
      newline
     ] [
      emit 'glue reduce [b/width]
     ]
    ]
   ]
   penalty [
    if b/ratio [
     r: max* -1 min* b/ratio rl
     if b/ref [
      emit 'box reduce [b/ref b/width b/height b/depth]
     ]
     skip?: yes
     newline
    ]
   ]
   cmd [
    emit 'cmd b/ref
   ]
   row [
    emit 'row b/ref
   ]
   table-start [
    tabend: find/skip b/self 'table-end text-list-node-size
    b/self: skip b/self text-list-node-size
    table: copy/part b/self tabend
    ; necessary because the function context is reused!
    use [rr ss] copy [
     rr: r
     ss: skip?
     emit 'table tabvlist-to-pages/with table 'rr 'ss
     r: rr
     skip?: ss
    ]
    b/self: tabend
   ]
  ]
 ]
 if sr [
  set sr r
  set ss skip?
 ]
]

5.7 Convert a table to a vertical list

〈Convert a table to a vertical list〉 ≡

output: make block! 10240
first-row?: yes
foreach row rows [
 append output compose [
  (make-text-list-node [type: 'row ref: row])
  (either first-row? [[ ]] [row/top-margin])
  (make-text-list-node [type: 'box width: 0])
  (make-text-list-node [type: 'penalty penalty: +infty])
  (row/top-padding)
 ]
 first-row?: no
 top-cells: copy []
 fl-height: 0
 fl-depth: 0
 foreach cell row/contents [
  cell/output: paras-to-vlist cell/contents reduce [cell/width 0] [ ]
  if all [cell/valign = 'top 'box = pick cell/output text-list-node!/type] [
   append top-cells cell
   first-line: pick cell/output text-list-node!/ref
   fl-height: max fl-height first-line/2
   fl-depth: max fl-depth first-line/3
  ]
 ]
 foreach cell top-cells [
  first-line: pick cell/output text-list-node!/ref
  first-line/2: fl-height
  first-line/3: fl-depth
  poke cell/output text-list-node!/width fl-height + fl-depth
 ]
 row-brkpnts: make block! 16
 foreach cell row/contents [
  append/only row-brkpnts calc-cell-height cell
 ]
 row-brkpnts: find-row-breakpoints row-brkpnts
 ; find last breakpoint - remove zero sized breakpoints
 until [
  last-brkpnt: copy skip tail row-brkpnts -5
  clear skip tail row-brkpnts -5
  not equal? last-brkpnt/1 pick tail row-brkpnts -5
 ]
 bh: bstr: bshr: 0
 foreach [h str shr pen offs] row-brkpnts [
  insert insert insert insert tail output
   make-text-list-node [type: 'box width: h - bh]
   make-text-list-node [type: 'penalty penalty: +infty]
   make-text-list-node [
    type: 'glue
    width: 0
    stretch: sub* str bstr
    shrink: shr - bshr
   ]
   make-text-list-node [type: 'penalty penalty: add* row/break-penalty pen]
  if offs > 0 [
   ; add offset in case of break
   insert insert insert insert tail output
    make-text-list-node [type: 'glue width: negate offs]
    make-text-list-node [type: 'box width: 0]
    make-text-list-node [type: 'penalty penalty: +infty]
    make-text-list-node [type: 'glue width: offs]
  ]
  bh: h bstr: str bshr: shr
 ]
 foreach [h str shr pen offs] last-brkpnt [
  insert insert insert tail output
   make-text-list-node [type: 'box width: h - bh]
   make-text-list-node [type: 'penalty penalty: +infty]
   make-text-list-node [
    type: 'glue
    width: 0
    stretch: sub* str bstr
    shrink: shr - bshr
   ]
 ]
 insert insert insert tail output
  row/bottom-padding
  make-text-list-node [type: 'box width: 0]
  row/bottom-margin
]
; remove last bottom margin
clear skip tail output negate text-list-node-size
output

5.7.1 table-to-vlist's locals

〈table-to-vlist's locals〉 ≡

output top-cells fl-height fl-depth first-line row-brkpnts
bh bstr bshr last-brkpnt first-row?

5.8 Split a table into pages, using the results of break-lines

〈Split a table into pages, using the results of break-lines〉 ≡

result: make block! 16
this-row: none
typeset-text-list/rlimit/with vlist func [type value] [
 switch type [
  box [
   ; value: [none height 0 0]
   if this-row [
    poke this-row/pages length? this-row/pages
     value/2 + pick this-row/pages length? this-row/pages
   ]
  ]
  glue [
   ; value [height ref]
   if this-row [
    either word? value/2 [
     set in this-row value/2 value/1
    ] [
     poke this-row/pages length? this-row/pages
      value/1 + pick this-row/pages length? this-row/pages
    ]
   ]
  ]
  row [
   〈Emit the previous row (if there is one)〉
   if this-row: value [this-row/pages: copy [0]]
  ]
 ]
] does [
 ; new page
 if this-row [
  append this-row/pages 0
 ]
 append/only result make block! 256
] 1 sr ss
〈Emit the previous row (if there is one)〉
result

5.8.1 tabvlist-to-pages' locals

〈tabvlist-to-pages' locals〉 ≡

result this-row cols rowh spc page roww this-cell curh

5.8.2 Emit the previous row (if there is one)

〈Emit the previous row (if there is one)〉 ≡

if this-row [
 if block? this-row/top-margin [this-row/top-margin: 0]
 if block? this-row/bottom-margin [this-row/bottom-margin: 0]
 foreach cell this-row/contents [
  cols: make block! 16
  rowh: 0
  foreach height this-row/pages [
   insert insert tail cols cell/width height
   rowh: rowh + height
  ]
  unless empty? cell/output [
   switch cell/valign [
    top [
     terminate-vlist cell/output
    ]
    bottom [
     spc: rowh - cell/height
     while [spc > this-row/pages/1] [
      cell/output: insert insert cell/output
       make-text-list-node [type: 'glue width: this-row/pages/1]
       make-text-list-node [type: 'penalty penalty: 0]
      spc: spc - this-row/pages/1
      this-row/pages: next this-row/pages
     ]
     this-row/pages: head this-row/pages
     cell/output: head insert cell/output make-text-list-node [type: 'glue width: spc]
     insert tail cell/output make-text-list-node [type: 'penalty penalty: -infty]
    ]
    middle [
     spc: rowh - cell/height / 2
     while [spc > this-row/pages/1] [
      cell/output: insert insert cell/output
       make-text-list-node [type: 'glue width: this-row/pages/1]
       make-text-list-node [type: 'penalty penalty: 0]
      spc: spc - this-row/pages/1
      this-row/pages: next this-row/pages
     ]
     this-row/pages: head this-row/pages
     cell/output: head insert cell/output make-text-list-node [type: 'glue width: spc]
     terminate-vlist cell/output
    ]
   ]
   cell/output: vlist-to-columns cell/output cols [ ]
  ]
  cell/height: rowh
 ]
 curh: 0
 while [not tail? this-row/pages] [
  if all [not head? this-row/pages zero? this-row/pages/1] [break]
  page: pick tail result negate length? this-row/pages
  rowh: first this-row/pages
  roww: 0
  if head? this-row/pages [
   repend page [
    0 this-row/top-margin + this-row/top-padding
   ]
  ]
  foreach cell this-row/contents [
   this-cell: pick cell/output index? this-row/pages
   roww: roww + cell/margins/1 + cell/padding/1 + cell/width
    + cell/padding/2 + cell/margins/2
   if not empty? cell/decor [
    repend page [
     'box
     0
     either any [tail? next this-row/pages zero? this-row/pages/2] [
      negate rowh + this-row/bottom-padding + this-row/bottom-margin
     ] [
      negate rowh
     ]
     cell/margins/1 + cell/padding/1 + cell/width + cell/padding/2 + cell/margins/2
     either head? this-row/pages [this-row/top-padding + this-row/top-margin] [0]
     bind/copy cell/decor context [
      xbl: cell/margins/1
      ybl: negate cell/height + this-row/bottom-padding - curh
      xtr: cell/margins/1 + cell/padding/1 + cell/width + cell/padding/2
      ytr: this-row/top-padding + curh
     ]
    ]
   ]
   either this-cell [
    repend page [
     cell/margins/1 + cell/padding/1 0
     this-cell
     cell/width + cell/padding/2 + cell/margins/2 negate rowh
    ]
   ] [
    repend page [
     cell/margins/1 + cell/padding/1 + cell/width +
     cell/padding/2 + cell/margins/2 0
    ]
   ]
  ]
  this-row/pages: next this-row/pages
  curh: curh + rowh
 ]
 repend page [
  negate roww rowh + this-row/bottom-padding + this-row/bottom-margin
 ]
]

5.9 Functions used by typeset-table

〈Functions used by typeset-table〉 ≡

calc-cell-height: func [cell /local breakpoints brk-shr brk-str pen pos] [
 cell/height: 0
 brk-shr: brk-str: 0
 breakpoints: make block! 32
 insert breakpoints cell/valign
 forblock b text-list-node! cell/output [
  pen: 0
  switch b/type [
   box [
    cell/height: cell/height + b/width
   ]
   kern [
    if (〈Is the next node a glue?〉) [〈Record as a possible breakpoint〉]
    cell/height: cell/height + b/width
   ]
   glue [
    if (〈Is the previous node a box?〉) [〈Record as a possible breakpoint〉]
    cell/height: cell/height + b/width
    brk-str: add* brk-str b/stretch
    brk-shr: brk-shr + b/shrink
   ]
   penalty [
    if not pos-inf? b/penalty [
     pen: b/penalty
     〈Record as a possible breakpoint〉
    ]
   ]
  ]
 ]
 pen: 0
 〈Record as a possible breakpoint〉
 breakpoints
]
pick-page: func [pages repeat-pages page] [
 either page > length? pages [
  if empty? repeat-pages [return none]
  page: page - 1 - (length? pages) // length? repeat-pages
  pick repeat-pages page + 1
 ] [
  pick pages page
 ]
]
find-row-breakpoints: func [
 cells
 /local biggest heights breakpoints chosen penalty offs
  ch cstr cshr cpen bh bhmax bhmin cpen' roff alignments
  ch' cstr' cshr'
] [
 breakpoints: make block! 32
 penalty: -infty
 offs: 0
 heights: make block! 2 + length? cells
 offs: make block! 2 + length? cells
 alignments: make block! 2 + length? cells
 biggest: 1
 foreach cell cells [
  append alignments cell/1
  remove cell
  cell: skip tail cell -4
  append heights cell/1
  if cell/1 > heights/:biggest [
   biggest: length? heights
  ]
 ]
 forever [
  chosen: 1
  repeat i length? cells [
   if any [
    tail? cells/:chosen
    all [
     not tail? cells/:i
     cells/:i/1 < cells/:chosen/1
    ]
   ] [
    chosen: i
   ]
  ]
  set [bh bhmax bhmin penalty] cells/:chosen
  bhmax: add* bh bhmax
  bhmin: bh - bhmin
  change/dup offs 0 length? cells
  repeat i length? cells [
   if i <> chosen [
    calc-cpen cells/:i alignments/:i bh [ch cstr cshr cpen]
    if all [
     not head? cells/:i
     gt* cpen calc-cpen skip cells/:i -4 alignments/:i bh [ch' cstr' cshr' cpen']
    ] [
     cpen: cpen'
     ch: ch' cstr: cstr' cshr: cshr'
    ]
    if all [
     not tail? skip cells/:i 4
     gt* cpen calc-cpen skip cells/:i 4 alignments/:i bh [ch' cstr' cshr' cpen']
    ] [
     cpen: cpen'
     ch: ch' cstr: cstr' cshr: cshr'
    ]
    penalty: max* penalty cpen
    bhmax: max* bh min* bhmax add* ch cstr
    bhmin: min bh max bhmin ch - cshr
    offs/:i: bh - ch
   ]
  ]
  unless pos-inf? penalty [
   roff: 0
   repeat i length? cells [
    if heights/:i + offs/:i > heights/:biggest [
     roff: max roff offs/:i
    ]
   ]
   repend breakpoints [
    bh sub* bhmax bh bh - bhmin penalty roff
   ]
  ]
  cells/:chosen: skip cells/:chosen 4
  if foreach cell cells [if not tail? cell [break/return false] true] [
   break
  ]
 ]
 breakpoints
]
calc-cpen: func [cell alignment bh words /local extra-str ch cstr cshr cpen r] [
 extra-str: either find [middle bottom] alignment [
  +infty
 ] [
  either tail? cell [+infty] [0]
 ]
 if tail? cell [cell: skip cell -4]
 set [ch cstr cshr cpen] cell
 cstr: add* cstr extra-str
 r: div* bh - ch either bh < ch [cshr] [cstr]
 cpen: case [
  lt* r -1 [+infty]
  pos-inf? r [+infty]
  true [add* cpen mul* 100 pow* min* 1E+15 abs* r 3]
 ]
 set words reduce [ch cstr cshr cpen]
 cpen
]

5.9.1 Record as a possible breakpoint

〈Record as a possible breakpoint〉 ≡

repend breakpoints [
 cell/height brk-str brk-shr pen
]