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