scm/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 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31
  32 (define TAGLINE
  33   (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
  34
  35 ;; TODO: take <optimally-broken-page-node> iso. page-number
  36 ;; for all of these functions ?
  37
  38 (define-public (plain-header layout scopes page-number last?)
  39   "Standard header for a part: page number --outside--  and instrument--centered."
  40
  41   (let* ((props (page-properties layout))
  42          (pnum
  43           (if (ly:output-def-lookup layout 'printpagenumber)
  44               (markup #:bold (number->string page-number))
  45               ""))
  46          (instr (ly:modules-lookup scopes 'instrument))
  47
  48          (line (list "" (if (markup? instr) instr "") pnum)))
  49
  50     (if (even? page-number)
  51         (set! line (reverse line)))
  52
  53     (if ((if (ly:output-def-lookup layout 'printfirstpagenumber)
  54              <=
  55              <)
  56          (ly:output-def-lookup layout 'firstpagenumber) page-number)
  57         (interpret-markup layout props (make-fill-line-markup line))
  58         '())))
  59
  60 ;; TODO: add publisher ID on non-first page.
  61 (define-public (plain-footer layout scopes page-number last?)
  62   "Standard footer. Empty, save for first (copyright) and last (tagline) page."
  63
  64   (let*
  65       ((props (page-properties layout))
  66        (copyright (ly:modules-lookup scopes 'copyright))
  67        (tagline-var (ly:modules-lookup scopes 'tagline))
  68        (tagline (if (markup? tagline-var) tagline-var TAGLINE))
  69        (stencil #f))
  70
  71     (if last?
  72         (set! stencil
  73               (ly:stencil-combine-at-edge
  74                stencil Y DOWN (interpret-markup layout props tagline)
  75                0.0
  76                )))
  77
  78     (if (and (= 1 page-number)
  79              (markup? copyright))
  80
  81         (set! stencil
  82               (ly:stencil-combine-at-edge
  83                stencil Y DOWN (interpret-markup layout props copyright)
  84                0.0
  85                )))
  86
  87     stencil))
  88
  89 (define (page-headfoot layout scopes number sym sepsym dir last?)
  90   "Create a stencil including separating space."
  91   (let*
  92       ((header-proc (ly:output-def-lookup layout sym))
  93        (sep (ly:output-def-lookup layout sepsym))
  94        (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
  95        (head-stencil
  96         (if (procedure? header-proc)
  97             (header-proc layout scopes number last?)
  98             #f)))
  99
 100     (if (and (number? sep) (ly:stencil? head-stencil))
 101         (set! head-stencil
 102               (ly:stencil-combine-at-edge
 103                stencil Y  dir head-stencil
 104                sep 0.0)))
 105
 106     head-stencil))
 107
 108 (define-public (default-page-music-height layout scopes number last?)
 109   "Printable area for music and titles; matches default-page-make-stencil."
 110   (let*
 111       ((h (- (ly:output-def-lookup layout 'vsize)
 112              (ly:output-def-lookup layout 'topmargin)
 113              (ly:output-def-lookup layout 'bottommargin)))
 114        (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
 115        (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
 116        (available
 117         (- h (if (ly:stencil? head)
 118                  (interval-length (ly:stencil-extent head Y))
 119                  0)
 120            (if (ly:stencil? foot)
 121                (interval-length (ly:stencil-extent foot Y))
 122                0))))
 123
 124 ;    (display (list "\n available" available head foot))
 125     available))
 126
 127 (define-public (default-page-make-stencil
 128                  lines offsets layout scopes number last? )
 129   "Construct a stencil representing the page from LINES.  "
 130   (let*
 131      ((topmargin  (ly:output-def-lookup layout 'topmargin))
 132
 133       ;; TODO: naming vsize/hsize not analogous to TeX.
 134
 135       (vsize (ly:output-def-lookup layout 'vsize))
 136       (hsize (ly:output-def-lookup layout 'hsize))
 137
 138       (lmargin (ly:output-def-lookup layout 'leftmargin))
 139       (leftmargin (if lmargin
 140                       lmargin
 141                       (/ (- hsize
 142                             (ly:output-def-lookup layout 'linewidth)) 2)))
 143
 144       (rightmargin (ly:output-def-lookup layout 'rightmargin))
 145       (bottom-edge (- vsize
 146                       (ly:output-def-lookup layout 'bottommargin)))
 147
 148       (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
 149       (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
 150
 151       (head-height (if (ly:stencil? head)
 152                        (interval-length (ly:stencil-extent head Y))
 153                        0.0))
 154
 155       (line-stencils (map ly:paper-system-stencil lines))
 156       (height-proc (ly:output-def-lookup layout 'page-music-height))
 157
 158       (page-stencil (ly:make-stencil '()
 159                                      (cons leftmargin hsize)
 160                                      (cons (- topmargin) 0)))
 161       (was-title #t)
 162       (add-system (lambda (stencil-position)
 163                     (set! page-stencil
 164                           (ly:stencil-add
 165                            (ly:stencil-translate-axis
 166                             (car stencil-position)
 167                             (- 0
 168                                head-height
 169                                (cadr stencil-position)
 170                                topmargin)
 171                                Y)
 172                            page-stencil))))
 173       )
 174
 175     (if #f
 176         (display (list
 177                   "leftmargin" leftmargin "rightmargin" rightmargin
 178                   )))
 179
 180     (set! page-stencil (ly:stencil-combine-at-edge
 181           page-stencil Y DOWN head 0. 0.))
 182
 183     (map add-system (zip line-stencils offsets))
 184     (if (ly:stencil? foot)
 185         (set! page-stencil
 186               (ly:stencil-add
 187                page-stencil
 188                (ly:stencil-translate
 189                 foot
 190                 (cons 0
 191                       (+ (- bottom-edge)
 192                          (- (car (ly:stencil-extent foot Y)))))
 193                 ))))
 194
 195     (ly:stencil-translate page-stencil (cons leftmargin 0))
 196   ))
 197
 198
 199
 200
 201 ;;; optimal page breaking
 202
 203 ;;; This is not optimal page breaking, this is optimal distribution of
 204 ;;; lines over pages; line breaks are a given.
 205
 206 ; TODO:
 207 ;
 208 ; - density scoring
 209 ; - separate function for word-wrap style breaking?
 210 ; - raggedbottom? raggedlastbottom?
 211
 212 (define-public (ly:optimal-page-breaks
 213                 lines paper-book)
 214   "Return pages as a list starting with 1st page. Each page is a list
 215 of lines. "
 216
 217
 218   (define MAXPENALTY 1e9)
 219   (define paper (ly:paper-book-paper paper-book))
 220   (define scopes (ly:paper-book-scopes paper-book))
 221
 222   (define (page-height page-number last?)
 223     (let
 224         ((p (ly:output-def-lookup paper 'page-music-height)))
 225
 226       (if (procedure? p)
 227           (p paper scopes page-number last?)
 228           10000)))
 229
 230   (define (get-path node done)
 231     "Follow NODE.PREV, and return as an ascending list of pages. DONE
 232 is what have collected so far, and has ascending page numbers."
 233
 234     (if (is-a? node <optimally-broken-page-node>)
 235         (get-path (node-prev node) (cons node done))
 236         done))
 237
 238   (define (combine-penalties force user best-paths)
 239     (let*
 240         ((prev-force  (if (null? best-paths)
 241                           0.0
 242                           (node-force  (car best-paths))))
 243          (prev-penalty (if (null? best-paths)
 244                            0.0
 245                            (node-penalty (car best-paths))))
 246          (inter-system-space (ly:output-def-lookup paper 'betweensystemspace))
 247          (force-equalization-factor 0.3)
 248          (relative-force (/ force inter-system-space))
 249          (abs-relative-force (abs relative-force))
 250          )
 251
 252
 253     (+ (* abs-relative-force (+ abs-relative-force 1))
 254        prev-penalty
 255        (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space))
 256        user)))
 257
 258   (define (space-systems page-height lines ragged?)
 259     (let*
 260         ((inter-system-space
 261           (ly:output-def-lookup paper 'betweensystemspace))
 262          (system-vector (list->vector
 263            (append lines
 264                    (if (= (length lines) 1)
 265                        '(#f)
 266                         '()))
 267            ))
 268
 269          (staff-extents
 270           (list->vector
 271            (append  (map
 272                      ly:paper-system-staff-extents
 273                      lines)
 274                     (if (= (length lines) 1)
 275                         '((0 .  0))
 276                         '()))
 277            ))
 278          (real-extents
 279           (list->vector
 280            (append
 281             (map
 282              (lambda (sys) (ly:paper-system-extent sys Y)) lines)
 283                     (if (= (length lines) 1)
 284                         '((0 .  0))
 285                         '())
 286                     )))
 287          (no-systems (vector-length real-extents))
 288          (topskip (interval-end (vector-ref real-extents 0)))
 289          (space-left (- page-height
 290                         (apply + (map interval-length (vector->list real-extents)))
 291
 292                         ))
 293
 294          (space (- page-height
 295                    topskip
 296                    (-  (interval-start (vector-ref real-extents (1- no-systems))))
 297                    ))
 298
 299          (fixed-dist (ly:output-def-lookup paper 'betweensystempadding))
 300          (calc-spring
 301           (lambda (idx)
 302             (let*
 303                 ((this-system-ext (vector-ref staff-extents idx))
 304                  (next-system-ext (vector-ref staff-extents (1+ idx)))
 305                  (fixed (max 0  (- (+ (interval-end next-system-ext)
 306                                       fixed-dist)
 307                                    (interval-start this-system-ext))))
 308                  (title1? (and (vector-ref system-vector idx)
 309                                (ly:paper-system-title? (vector-ref system-vector idx))))
 310                  (title2? (and
 311                             (vector-ref system-vector (1+ idx))
 312                             (ly:paper-system-title? (vector-ref system-vector (1+ idx)))))
 313                  (ideal (+
 314                          (cond
 315                           ((and title2? title1?)
 316                            (ly:output-def-lookup paper 'betweentitlespace))
 317                           (title1?
 318                            (ly:output-def-lookup paper 'aftertitlespace))
 319                           (title2?
 320                            (ly:output-def-lookup paper 'beforetitlespace))
 321                           (else inter-system-space))
 322                          fixed))
 323                  (hooke (/ 1 (- ideal fixed)))
 324                  )
 325               (list ideal hooke))
 326             ))
 327
 328          (springs (map calc-spring (iota (1- no-systems))))
 329          (calc-rod
 330           (lambda (idx)
 331             (let*
 332                 ((this-system-ext (vector-ref real-extents idx))
 333                  (next-system-ext (vector-ref real-extents (1+ idx)))
 334                  (distance (max  (- (+ (interval-end next-system-ext)
 335                                  fixed-dist)
 336                                     (interval-start this-system-ext)
 337                                     ) 0))
 338                  (entry (list idx (1+ idx) distance)))
 339               entry)))
 340          (rods (map calc-rod (iota (1- no-systems))))
 341
 342          ;; we don't set ragged based on amount space left.
 343          ;; raggedbottomlast = ##T is much more predictable
 344          (result (ly:solve-spring-rod-problem
 345                   springs rods space
 346                   ragged?))
 347
 348          (force (car result))
 349          (positions
 350           (map (lambda (y)
 351                        (+ y topskip))
 352                (cdr  result)))
 353          )
 354
 355       (if #f ;; debug.
 356           (begin
 357            (display (list "\n# systems: " no-systems
 358                           "\nreal-ext" real-extents "\nstaff-ext" staff-extents
 359                           "\ninterscore" inter-system-space
 360                           "\nspace-letf" space-left
 361                           "\nspring,rod" springs rods
 362                           "\ntopskip " topskip
 363                           " space " space
 364                           "\npage-height" page-height
 365                           "\nragged" ragged?
 366                           "\nforce" force
 367                           "\nres" (cdr result)
 368                           "\npositions" positions "\n"))))
 369
 370      (cons force positions)))
 371
 372   (define (walk-paths done-lines best-paths current-lines  last? current-best)
 373     "Return the best optimal-page-break-node that contains
 374 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
 375 ascending range of lines, and BEST-PATHS contains the optimal breaks
 376 corresponding to DONE-LINES.
 377
 378 CURRENT-BEST is the best result sofar, or #f."
 379
 380     (let* ((this-page-num (if (null? best-paths)
 381                               (ly:output-def-lookup paper 'firstpagenumber)
 382                               (1+ (node-page-number (car best-paths)))))
 383
 384            (ragged-all? (eq? #t (ly:output-def-lookup paper 'raggedbottom)))
 385            (ragged-last? (eq? #t (ly:output-def-lookup paper 'raggedlastbottom)))
 386            (ragged? (or ragged-all?
 387                         (and ragged-last?
 388                              last?)))
 389            (page-height (page-height this-page-num last?))
 390            (vertical-spacing (space-systems page-height current-lines ragged?))
 391            (satisfied-constraints (car vertical-spacing))
 392            (force (if satisfied-constraints
 393                       (if (and last? ragged-last?)
 394                           0.0
 395                           satisfied-constraints)
 396                       10000))
 397            (positions (cdr vertical-spacing))
 398            (user-penalty (ly:paper-system-break-penalty (car current-lines)))
 399            (total-penalty (combine-penalties
 400                            force user-penalty
 401                            best-paths))
 402
 403
 404            (better? (or
 405                      (not current-best)
 406                      (< total-penalty (node-penalty current-best))))
 407            (new-best (if better?
 408                          (make <optimally-broken-page-node>
 409                            #:prev  (if (null? best-paths)
 410                                         #f
 411                                         (car best-paths))
 412                            #:lines current-lines
 413                            #:pageno this-page-num
 414                            #:force force
 415                            #:configuration positions
 416                            #:penalty total-penalty)
 417                          current-best)))
 418
 419       (if #f ;; debug
 420           (display
 421            (list
 422             "\nuser pen " user-penalty
 423             "\nsatisfied-constraints" satisfied-constraints
 424             "\nlast? " last? "ragged?" ragged?
 425             "\nbetter? " better? " total-penalty " total-penalty "\n"
 426             "\nconfig " positions
 427             "\nforce " force
 428             "\nlines: " current-lines "\n")))
 429
 430       (if #f ; debug
 431           (display (list "\nnew-best is " (node-lines new-best)
 432                          "\ncontinuation of "
 433                          (if (null? best-paths)
 434                              "start"
 435                              (node-lines (car best-paths))))))
 436
 437       (if (and (pair? done-lines)
 438                ;; if this page is too full, adding another line won't help
 439                satisfied-constraints)
 440           (walk-paths (cdr done-lines) (cdr best-paths)
 441                       (cons (car done-lines) current-lines)
 442                       last? new-best)
 443
 444           new-best)))
 445
 446   (define (walk-lines done best-paths todo)
 447     "Return the best page breaking as a single
 448 <optimal-page-break-node> for optimally breaking TODO ++
 449 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 450 DONE."
 451     (if (null? todo)
 452         (car best-paths)
 453         (let* ((this-line (car todo))
 454                (last? (null? (cdr todo)))
 455                (next (walk-paths done best-paths (list this-line) last? #f)))
 456
 457 ;         (display "\n***************")
 458           (walk-lines (cons this-line done)
 459                       (cons next best-paths)
 460                       (cdr todo)))))
 461
 462   (define (line-number node)
 463     (ly:paper-system-number (car (node-lines node))))
 464
 465   (let* ((best-break-node (walk-lines '() '() lines))
 466          (break-nodes (get-path best-break-node '())))
 467
 468     (if #f; (ly:get-option 'verbose)
 469         (begin
 470           (display (list
 471                     "\nbreaks: " (map line-number break-nodes))
 472                     "\nsystems " (map node-lines break-nodes)
 473                     "\npenalties " (map node-penalty break-nodes)
 474                     "\nconfigs " (map node-configuration break-nodes))))
 475
 476
 477     ; create stencils.
 478
 479     (map (lambda (node)
 480            ((ly:output-def-lookup paper 'page-make-stencil)
 481             (node-lines node)
 482             (node-configuration node)
 483             paper
 484             scopes
 485             (node-page-number node)
 486             (eq? node best-break-node)))
 487          break-nodes)))
 488
 489