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