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