scm/layout-page-layout.scm

   1 ;;;; page-layout.scm -- page breaking and page layout
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2004--2005 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;;          Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8 (use-modules (oop goops describe)
   9              (oop goops))
  10
  11
  12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13
  14 (define-class <optimally-broken-page-node> ()
  15   (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev)
  16   (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno)
  17   (force #:init-value 0 #:accessor node-force #:init-keyword #:force)
  18   (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty)
  19   (configuration #:init-value '() #:accessor node-configuration #:init-keyword #:configuration)
  20   (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
  21
  22 (define-method (display (node <optimally-broken-page-node>) port)
  23   (map (lambda (x) (display x port))
  24        (list
  25         "Page " (node-page-number node)
  26         " Lines: " (node-lines node)
  27         " Penalty " (node-penalty node)
  28         "\n")))
  29
  30 (define-method (node-system-numbers (node <optimally-broken-page-node>))
  31   (map (lambda (ps) (ly:paper-system-property ps 'number))
  32        (node-lines node)))
  33
  34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35
  36 (define (annotate? layout)
  37   (eq? #t (ly:output-def-lookup layout 'annotatespacing)))
  38
  39
  40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41
  42 (define-public (paper-system-staff-extents ps)
  43   (ly:paper-system-property ps 'refpoint-Y-extent '(0 . 0)))
  44
  45
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47 ;; ANNOTATIONS
  48 ;;
  49 ;; annotations are arrows indicating the numerical value of
  50 ;; spacing variables
  51 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  52
  53 (define (annotate-y-interval layout name extent is-length?)
  54   ;; do something sensible for 0,0 intervals.
  55   (set! extent (interval-widen extent 0.001))
  56   (let*
  57       ((text-props (cons
  58                     '((font-size . -3)
  59                       (font-family . typewriter))
  60                     (layout-extract-page-properties layout)))
  61        (annotation (interpret-markup
  62                     layout text-props
  63                     (make-column-markup
  64                      (list
  65                       (make-whiteout-markup (make-simple-markup name))
  66                       (make-whiteout-markup
  67                        (make-simple-markup
  68                         (if is-length?
  69                             (format "~$" (interval-length extent))
  70                             (format "(~$,~$)" (car extent)
  71                                     (cdr extent)))))))))
  72        (arrows
  73         (ly:stencil-translate-axis
  74          (dimension-arrows (cons 0 (interval-length extent)))
  75          (interval-start extent) Y)))
  76
  77     (set! annotation
  78           (ly:stencil-aligned-to annotation Y CENTER))
  79
  80     (set! annotation (ly:stencil-translate annotation
  81                           (cons 0 (interval-center extent))))
  82
  83     (set! annotation
  84           (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5 0))
  85
  86     (set! annotation
  87           (ly:make-stencil (ly:stencil-expr annotation)
  88                            (ly:stencil-extent annotation X)
  89                            (cons 10000 -10000)))
  90     annotation))
  91
  92 (define (paper-system-annotate-last system layout)
  93   (let*
  94       ((bottomspace (ly:paper-system-property system 'bottom-space))
  95        (y-extent (paper-system-extent system Y))
  96        (x-extent (paper-system-extent system X))
  97        (stencil (ly:paper-system-property system 'stencil))
  98
  99        (arrow (if (number? bottomspace)
 100                (annotate-y-interval layout
 101                                     "bottom-space"
 102                                     (cons (- (car y-extent) bottomspace)
 103                                           (car y-extent))
 104                                     #t)
 105                #f)))
 106
 107     (if arrow
 108         (set! stencil
 109               (ly:stencil-add stencil arrow)))
 110
 111     (set! (ly:paper-system-property system 'stencil)
 112           stencil)
 113   ))
 114
 115 (define (paper-system-annotate system layout)
 116   "Add arrows and texts to indicate which lengths are set."
 117   (let*
 118       ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
 119        (append-stencil
 120         (lambda (a b)
 121           (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
 122
 123        (annotate-property
 124         (lambda (name extent is-length?)
 125           (set! annotations
 126                 (append-stencil annotations
 127                                 (annotate-y-interval layout
 128                                                      name extent is-length?)))))
 129
 130        (bbox-extent (paper-system-extent system Y))
 131        (refp-extent (ly:paper-system-property system 'refpoint-Y-extent))
 132        (next-space (ly:paper-system-property system 'next-space
 133                                              (ly:output-def-lookup layout 'betweensystemspace)
 134                                              ))
 135        (next-padding (ly:paper-system-property system 'next-padding
 136                                                (ly:output-def-lookup layout 'betweensystempadding)
 137                                                ))
 138
 139        )
 140
 141     (if (number-pair? bbox-extent)
 142         (begin
 143           (annotate-property  "Y-extent"
 144                                bbox-extent #f)
 145           (annotate-property  "next-padding"
 146                              (interval-translate (cons (- next-padding) 0) (car bbox-extent))
 147                              #t)))
 148
 149     ;; titles don't have a refpoint-Y-extent.
 150     (if (number-pair? refp-extent)
 151         (begin
 152           (annotate-property "refpoint-Y-extent"
 153                              refp-extent #f)
 154
 155           (annotate-property "next-space"
 156                              (interval-translate (cons (- next-space) 0) (car refp-extent))
 157                        #t)))
 158
 159
 160
 161     (set! (ly:paper-system-property system 'stencil)
 162           (ly:stencil-add
 163            (ly:paper-system-property system 'stencil)
 164            (ly:make-stencil
 165             (ly:stencil-expr annotations)
 166             (ly:stencil-extent empty-stencil X)
 167             (ly:stencil-extent empty-stencil Y)
 168             )))
 169
 170     ))
 171
 172 (define (annotate-page layout stencil)
 173   (let*
 174       ((topmargin (ly:output-def-lookup layout 'topmargin))
 175        (vsize (ly:output-def-lookup layout 'vsize))
 176        (bottommargin (ly:output-def-lookup layout 'bottommargin))
 177        (add-stencil (lambda (y)
 178                       (set! stencil
 179                             (ly:stencil-add stencil y))
 180                       )))
 181
 182     (add-stencil
 183      (ly:stencil-translate-axis
 184       (annotate-y-interval layout "vsize"
 185                            (cons (- vsize) 0)
 186                            #t)
 187       1 X))
 188
 189
 190     (add-stencil
 191      (ly:stencil-translate-axis
 192       (annotate-y-interval layout "topmargin"
 193                            (cons (- topmargin) 0)
 194                            #t)
 195       2 X))
 196
 197     (add-stencil
 198      (ly:stencil-translate-axis
 199       (annotate-y-interval layout "bottommargin"
 200                            (cons (- vsize) (- bottommargin vsize))
 201                            #t)
 202       2 X))
 203
 204     stencil))
 205
 206 (define (annotate-space-left page-stencil layout bottom-edge)
 207   (let*
 208       ((arrow (annotate-y-interval layout
 209                                 "space left"
 210                                 (cons (- bottom-edge)  (car (ly:stencil-extent page-stencil Y)))
 211                                 #t)))
 212
 213     (set! arrow (ly:stencil-translate-axis arrow 8 X))
 214     (ly:stencil-add page-stencil arrow)))
 215
 216 \f
 217 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 218
 219
 220 (define (page-headfoot layout scopes number
 221                        sym separation-symbol dir last?)
 222   "Create a stencil including separating space."
 223
 224   (let* ((header-proc (ly:output-def-lookup layout sym))
 225          (sep (ly:output-def-lookup layout separation-symbol))
 226          (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
 227          (head-stencil
 228           (if (procedure? header-proc)
 229               (header-proc layout scopes number last?)
 230               #f))
 231          )
 232
 233     (if (and (number? sep)
 234              (ly:stencil? head-stencil)
 235              (not (ly:stencil-empty? head-stencil)))
 236
 237         (begin
 238           (set! head-stencil
 239                 (ly:stencil-combine-at-edge
 240                  stencil Y dir head-stencil
 241                  sep 0.0))
 242
 243
 244           ;; add arrow markers
 245           (if (annotate? layout)
 246               (set! head-stencil
 247                     (ly:stencil-add
 248                      (ly:stencil-translate-axis
 249                       (annotate-y-interval layout
 250                                            (symbol->string separation-symbol)
 251                                            (cons (min 0 (* dir sep))
 252                                                  (max 0 (* dir sep)))
 253                                            #t)
 254                       (/ (ly:output-def-lookup layout 'linewidth) 2)
 255                       X)
 256                      (if (= dir UP)
 257                          (ly:stencil-translate-axis
 258                           (annotate-y-interval layout
 259                                               "pagetopspace"
 260                                               (cons
 261                                                (- (min 0 (* dir sep))
 262                                                   (ly:output-def-lookup layout 'pagetopspace))
 263                                                (min 0 (* dir sep)))
 264                                               #t)
 265                           (+ 7 (interval-center (ly:stencil-extent head-stencil X))) X)
 266                          empty-stencil
 267                          )
 268                      head-stencil
 269                      ))
 270               )))
 271
 272     head-stencil))
 273
 274 (define-public (default-page-music-height layout scopes number last?)
 275   "Printable area for music and titles; matches default-page-make-stencil."
 276   (let* ((h (- (ly:output-def-lookup layout 'vsize)
 277                (ly:output-def-lookup layout 'topmargin)
 278                (ly:output-def-lookup layout 'bottommargin)))
 279
 280        (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
 281        (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
 282        (available
 283         (- h (if (ly:stencil? head)
 284                  (interval-length (ly:stencil-extent head Y))
 285                  0)
 286            (if (ly:stencil? foot)
 287                (interval-length (ly:stencil-extent foot Y))
 288                0))))
 289
 290     ;; (display (list "\n available" available head foot))
 291     available))
 292
 293 (define-public (default-page-make-stencil
 294                  lines offsets layout scopes number last?)
 295   "Construct a stencil representing the page from LINES.
 296
 297  Offsets is a list of increasing numbers. They must be negated to
 298 create offsets.
 299  "
 300
 301   (let* ((topmargin (ly:output-def-lookup layout 'topmargin))
 302
 303        ;; TODO: naming vsize/hsize not analogous to TeX.
 304
 305          (vsize (ly:output-def-lookup layout 'vsize))
 306          (hsize (ly:output-def-lookup layout 'hsize))
 307
 308          (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0))
 309          (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
 310          (system-separator-stencil (if (markup? system-separator-markup)
 311                                        (interpret-markup layout
 312                                                          (layout-extract-page-properties layout)
 313                                                          system-separator-markup)
 314                                        #f))
 315          (lmargin (ly:output-def-lookup layout 'leftmargin))
 316          (leftmargin (if lmargin
 317                          lmargin
 318                          (/ (- hsize
 319                                (ly:output-def-lookup layout 'linewidth)) 2)))
 320
 321          (rightmargin (ly:output-def-lookup layout 'rightmargin))
 322          (bottom-edge (- vsize
 323                          (ly:output-def-lookup layout 'bottommargin)))
 324
 325          (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
 326          (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
 327
 328          (head-height (if (ly:stencil? head)
 329                           (interval-length (ly:stencil-extent head Y))
 330                           0.0))
 331
 332          (height-proc (ly:output-def-lookup layout 'page-music-height))
 333
 334          (page-stencil (ly:make-stencil '()
 335                                         (cons leftmargin hsize)
 336                                         (cons (- topmargin) 0)))
 337          (last-system #f)
 338          (last-y 0.0)
 339          (add-to-page (lambda (stencil y)
 340                         (set! page-stencil
 341                               (ly:stencil-add page-stencil
 342                                               (ly:stencil-translate stencil
 343                                                                     (cons
 344                                                                      system-xoffset
 345                                                                      (- 0 head-height y topmargin))
 346
 347                                                                     )))))
 348          (add-system
 349           (lambda (stencil-position)
 350             (let* ((system (car stencil-position))
 351                    (stencil (paper-system-stencil system))
 352                    (y (cadr stencil-position))
 353                    (is-title (paper-system-title?
 354                               (car stencil-position))))
 355               (add-to-page stencil y)
 356               (if (and (ly:stencil? system-separator-stencil)
 357                        last-system
 358                        (not (paper-system-title? system))
 359                        (not (paper-system-title? last-system)))
 360                   (add-to-page
 361                    system-separator-stencil
 362                    (average (- last-y
 363                                (car (paper-system-staff-extents last-system)))
 364                             (- y
 365                                (cdr (paper-system-staff-extents system))))))
 366               (set! last-system system)
 367               (set! last-y y))))
 368          )
 369
 370
 371     (if (annotate? layout)
 372         (begin
 373           (for-each (lambda (sys) (paper-system-annotate sys layout))
 374                     lines)
 375           (paper-system-annotate-last (car (last-pair lines)) layout)))
 376
 377
 378     (if #f
 379         (display (list
 380                   "leftmargin " leftmargin "rightmargin " rightmargin
 381                   )))
 382
 383     (set! page-stencil (ly:stencil-combine-at-edge
 384                         page-stencil Y DOWN
 385                         (if (and
 386                              (ly:stencil? head)
 387                              (not (ly:stencil-empty? head)))
 388                             head
 389                             (ly:make-stencil "" (cons 0 0) (cons 0 0)))
 390                             0. 0.))
 391
 392     (map add-system (zip lines offsets))
 393
 394     (if (annotate? layout)
 395         (set!
 396          page-stencil
 397          (annotate-space-left page-stencil layout
 398                               (- bottom-edge
 399                                  (if (ly:stencil? foot)
 400                                      (interval-length (ly:stencil-extent foot Y))
 401                                      0)))
 402          ))
 403
 404
 405     (if (and (ly:stencil? foot)
 406              (not (ly:stencil-empty? foot)))
 407         (set! page-stencil
 408               (ly:stencil-add
 409                page-stencil
 410                (ly:stencil-translate
 411                 foot
 412                 (cons 0
 413                       (+ (- bottom-edge)
 414                          (- (car (ly:stencil-extent foot Y)))))))))
 415
 416     (set! page-stencil
 417           (ly:stencil-translate page-stencil (cons leftmargin 0)))
 418
 419     ;; annotation.
 420     (if (annotate? layout)
 421         (set! page-stencil (annotate-page layout page-stencil)))
 422
 423
 424     page-stencil))
 425
 426 ;;; optimal page breaking
 427
 428 ;;; This is not optimal page breaking, this is optimal distribution of
 429 ;;; lines over pages; line breaks are a given.
 430
 431 ;; TODO:
 432 ;;
 433 ;; - density scoring
 434 ;; - separate function for word-wrap style breaking?
 435 ;; - raggedbottom? raggedlastbottom?
 436
 437 (define-public (optimal-page-breaks lines paper-book)
 438   "Return pages as a list starting with 1st page. Each page is a list
 439 of lines. "
 440
 441   (define MAXPENALTY 1e9)
 442   (define paper (ly:paper-book-paper paper-book))
 443   (define scopes (ly:paper-book-scopes paper-book))
 444   (define force-equalization-factor #f)
 445
 446   (define (page-height page-number last?)
 447     (let ((p (ly:output-def-lookup paper 'page-music-height)))
 448
 449       (if (procedure? p)
 450           (p paper scopes page-number last?)
 451           10000)))
 452
 453   (define (get-path node done)
 454     "Follow NODE.PREV, and return as an ascending list of pages. DONE
 455 is what have collected so far, and has ascending page numbers."
 456
 457     (if (is-a? node <optimally-broken-page-node>)
 458         (get-path (node-prev node) (cons node done))
 459         done))
 460
 461   (define (combine-penalties force user best-paths)
 462     (let* ((prev-force (if (null? best-paths)
 463                            0.0
 464                            (node-force (car best-paths))))
 465            (prev-penalty (if (null? best-paths)
 466                              0.0
 467                              (node-penalty (car best-paths))))
 468          (inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
 469          (relative-force (/ force inter-system-space))
 470          (abs-relative-force (abs relative-force)))
 471
 472
 473       (+ (* abs-relative-force (+ abs-relative-force 1))
 474          prev-penalty
 475          (* force-equalization-factor (/ (abs (- prev-force force))
 476                                          inter-system-space))
 477          user)))
 478
 479   (define (space-systems page-height lines ragged?)
 480     (let* ((global-inter-system-space
 481             (ly:output-def-lookup paper 'betweensystemspace))
 482            (top-space
 483             (ly:output-def-lookup paper 'pagetopspace))
 484            (global-fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
 485
 486            (system-vector (list->vector
 487                            (append lines
 488                                    (if (= (length lines) 1)
 489                                        '(#f)
 490                                        '()))))
 491            (staff-extents
 492             (list->vector
 493              (append (map paper-system-staff-extents lines)
 494                      (if (= (length lines) 1)
 495                          '((0 . 0))
 496                          '()))))
 497
 498            (real-extents
 499             (list->vector
 500              (append
 501               (map
 502                (lambda (sys) (paper-system-extent sys Y)) lines)
 503               (if (= (length lines) 1)
 504                   '((0 .  0))
 505                   '()))))
 506
 507            (system-count (vector-length real-extents))
 508            (topskip (max
 509                      (+
 510                       top-space
 511                       (interval-end (vector-ref staff-extents 0)))
 512                      (interval-end (vector-ref real-extents 0))
 513                      ))
 514            (last-system (vector-ref system-vector (1- system-count)))
 515            (bottom-space (if (ly:paper-system? last-system)
 516                              (ly:paper-system-property last-system 'bottom-space 0.0)
 517                              0.0))
 518            (space-left (- page-height
 519                           bottom-space
 520                           (apply + (map interval-length
 521                                         (vector->list real-extents)))))
 522
 523            (space (- page-height
 524                      topskip
 525                      bottom-space
 526                      (-  (interval-start
 527                           (vector-ref real-extents (1- system-count))))))
 528
 529            (calc-spring
 530             (lambda (idx)
 531               (let* (
 532                      (upper-system (vector-ref system-vector idx))
 533                      (between-space (ly:paper-system-property upper-system 'next-space
 534                                                               global-inter-system-space))
 535                      (fixed-dist (ly:paper-system-property upper-system 'next-padding
 536                                                            global-fixed-dist))
 537
 538                      (this-system-ext (vector-ref staff-extents idx))
 539                      (next-system-ext (vector-ref staff-extents (1+ idx)))
 540                      (fixed (max 0 (- (+ (interval-end next-system-ext)
 541                                          fixed-dist)
 542                                       (interval-start this-system-ext))))
 543                      (title1? (and (vector-ref system-vector idx)
 544                                    (paper-system-title? (vector-ref system-vector idx)
 545                                                              )))
 546                      (title2? (and
 547                                (vector-ref system-vector (1+ idx))
 548                                (paper-system-title? (vector-ref system-vector (1+ idx)))))
 549                      (ideal (+
 550                              (cond
 551                               ((and title2? title1?)
 552                                (ly:output-def-lookup paper 'betweentitlespace))
 553                               (title1?
 554                                (ly:output-def-lookup paper 'aftertitlespace))
 555                               (title2?
 556                                (ly:output-def-lookup paper 'beforetitlespace))
 557                               (else between-space))
 558                              fixed))
 559                      (hooke (/ 1 (- ideal fixed))))
 560                 (list ideal hooke))))
 561
 562            (springs (map calc-spring (iota (1- system-count))))
 563            (calc-rod
 564             (lambda (idx)
 565               (let* (
 566                      (upper-system (vector-ref system-vector idx))
 567                      (fixed-dist (ly:paper-system-property upper-system 'next-padding
 568                                                            global-fixed-dist))
 569                      (this-system-ext (vector-ref real-extents idx))
 570                      (next-system-ext (vector-ref real-extents (1+ idx)))
 571
 572                      (distance (max  (- (+ (interval-end next-system-ext)
 573                                            fixed-dist)
 574                                         (interval-start this-system-ext)
 575                                         ) 0))
 576                      (entry (list idx (1+ idx) distance)))
 577                 entry)))
 578            (rods (map calc-rod (iota (1- system-count))))
 579
 580            ;; we don't set ragged based on amount space left.
 581            ;; raggedbottomlast = ##T is much more predictable
 582            (result (ly:solve-spring-rod-problem
 583                     springs rods space
 584                     ragged?))
 585
 586            (force (car result))
 587            (positions
 588             (map (lambda (y)
 589                    (+ y topskip))
 590                  (cdr  result))))
 591
 592       (if #f ;; debug.
 593           (begin
 594             (display (list "\n# systems: " system-count
 595                            "\nreal-ext" real-extents "\nstaff-ext" staff-extents
 596                            "\ninterscore" global-inter-system-space
 597                            "\nspace-left" space-left
 598                            "\nspring,rod" springs rods
 599                            "\ntopskip " topskip
 600                            " space " space
 601                            "\npage-height" page-height
 602                            "\nragged" ragged?
 603                            "\nforce" force
 604                            "\nres" (cdr result)
 605                            "\npositions" positions "\n"))))
 606
 607       (cons force positions)))
 608
 609   (define (walk-paths done-lines best-paths current-lines  last? current-best)
 610     "Return the best optimal-page-break-node that contains
 611 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
 612 ascending range of lines, and BEST-PATHS contains the optimal breaks
 613 corresponding to DONE-LINES.
 614
 615 CURRENT-BEST is the best result sofar, or #f."
 616
 617
 618     (let* ((this-page-num (if (null? best-paths)
 619                               (ly:output-def-lookup paper 'firstpagenumber)
 620                               (1+ (node-page-number (car best-paths)))))
 621
 622            (ragged-all? (eq? #t (ly:output-def-lookup paper 'raggedbottom)))
 623            (ragged-last? (eq? #t (ly:output-def-lookup paper 'raggedlastbottom)))
 624            (ragged? (or ragged-all?
 625                         (and ragged-last?
 626                              last?)))
 627            (page-height (page-height this-page-num last?))
 628            (vertical-spacing (space-systems page-height current-lines ragged?))
 629            (satisfied-constraints (car vertical-spacing))
 630            (force (if satisfied-constraints
 631                       (if (and last? ragged-last?)
 632                           0.0
 633                           satisfied-constraints)
 634                       10000))
 635            (positions (cdr vertical-spacing))
 636            (get-break-penalty (lambda (sys)
 637                                 (ly:paper-system-property sys 'penalty 0.0)))
 638            (user-nobreak-penalties
 639             (-
 640              (apply + (filter negative?
 641                               (map get-break-penalty
 642                                    (cdr current-lines))))))
 643            (user-penalty
 644             (+
 645              (max (get-break-penalty (car current-lines)) 0.0)
 646              user-nobreak-penalties))
 647
 648            (total-penalty (combine-penalties
 649                            force user-penalty
 650                            best-paths))
 651
 652            (better? (or
 653                      (not current-best)
 654                      (< total-penalty (node-penalty current-best))))
 655            (new-best (if better?
 656                          (make <optimally-broken-page-node>
 657                            #:prev (if (null? best-paths)
 658                                       #f
 659                                       (car best-paths))
 660                            #:lines current-lines
 661                            #:pageno this-page-num
 662                            #:force force
 663                            #:configuration positions
 664                            #:penalty total-penalty)
 665                          current-best)))
 666
 667 ;;      (display total-penalty) (newline)
 668       (if #f ;; debug
 669           (display
 670            (list
 671             "\nuser pen " user-penalty
 672             "\nsatisfied-constraints" satisfied-constraints
 673             "\nlast? " last? "ragged?" ragged?
 674             "\nbetter? " better? " total-penalty " total-penalty "\n"
 675             "\nconfig " positions
 676             "\nforce " force
 677             "\nlines: " current-lines "\n")))
 678
 679       (if #f ; debug
 680           (display (list "\nnew-best is " (node-lines new-best)
 681                          "\ncontinuation of "
 682                          (if (null? best-paths)
 683                              "start"
 684                              (node-lines (car best-paths))))))
 685
 686       (if (and (pair? done-lines)
 687                ;; if this page is too full, adding another line won't help
 688                satisfied-constraints)
 689           (walk-paths (cdr done-lines) (cdr best-paths)
 690                       (cons (car done-lines) current-lines)
 691                       last? new-best)
 692           new-best)))
 693
 694   (define (walk-lines done best-paths todo)
 695     "Return the best page breaking as a single
 696 <optimal-page-break-node> for optimally breaking TODO ++
 697 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 698 DONE."
 699
 700     (if (null? todo)
 701         (car best-paths)
 702         (let* ((this-line (car todo))
 703                (last? (null? (cdr todo)))
 704                (next (walk-paths done best-paths (list this-line) last? #f)))
 705
 706           ;; (display "\n***************")
 707           (walk-lines (cons this-line done)
 708                       (cons next best-paths)
 709                       (cdr todo)))))
 710
 711   (define (line-number node)
 712     (ly:paper-system-property (car (node-lines node)) 'number))
 713
 714   (ly:message (_ "Calculating page breaks..."))
 715   (set! force-equalization-factor
 716         (ly:output-def-lookup paper 'verticalequalizationfactor 0.3))
 717
 718   (let* ((best-break-node (walk-lines '() '() lines))
 719          (break-nodes (get-path best-break-node '()))
 720          (last-node (car (last-pair break-nodes))))
 721
 722     (define (node->page-stencil node)
 723       (if (not (eq? node last-node))
 724           (ly:progress "["))
 725       (let ((stencil
 726              ((ly:output-def-lookup paper 'page-make-stencil)
 727               (node-lines node)
 728               (node-configuration node)
 729               paper
 730               scopes
 731               (node-page-number node)
 732               (eq? node best-break-node))))
 733         (if (not (eq? node last-node))
 734             (begin
 735               (ly:progress (number->string
 736                             (car (last-pair (node-system-numbers node)))))
 737               (ly:progress "]")))
 738         stencil))
 739
 740     (if #f; (ly:get-option 'verbose)
 741         (begin
 742           (display (list
 743                     "\nbreaks: " (map line-number break-nodes))
 744                    "\nsystems " (map node-lines break-nodes)
 745                    "\npenalties " (map node-penalty break-nodes)
 746                    "\nconfigs " (map node-configuration break-nodes))))
 747
 748     (let ((stencils (map node->page-stencil break-nodes)))
 749       (ly:progress "\n")
 750       stencils)))