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