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       (line-stencils (map ly:paper-system-stencil lines))
 147       (height-proc (ly:output-def-lookup paper 'page-music-height))
 148
 149       (page-stencil (ly:make-stencil '()
 150                                      (cons leftmargin hsize)
 151                                      (cons (- topmargin) 0)))
 152       (was-title #t)
 153       (add-system (lambda (stencil-position)
 154                     (set! page-stencil
 155                           (ly:stencil-add
 156                            (ly:stencil-translate-axis
 157                             (car stencil-position)
 158                             (- 0
 159                                (cadr stencil-position)
 160                                topmargin)
 161                                Y)
 162                            page-stencil))))
 163       )
 164
 165
 166     (map add-system (zip line-stencils offsets))
 167     (if (ly:stencil? foot)
 168         (set! page-stencil
 169               (ly:stencil-add
 170                page-stencil
 171                (ly:stencil-translate
 172                 foot
 173                 (cons 0
 174                       (+ (- bottom-edge)
 175                          (- (car (ly:stencil-extent foot Y)))))
 176                 ))))
 177
 178     (ly:stencil-translate page-stencil (cons leftmargin 0))
 179   ))
 180
 181
 182
 183
 184 ;;; optimal page breaking
 185
 186 ;;; This is not optimal page breaking, this is optimal distribution of
 187 ;;; lines over pages; line breaks are a given.
 188
 189 ; TODO:
 190 ;
 191 ; - density scoring
 192 ; - separate function for word-wrap style breaking?
 193 ; - raggedbottom? raggedlastbottom?
 194
 195 (define-public (ly:optimal-page-breaks
 196                 lines paper-book)
 197   "Return pages as a list starting with 1st page. Each page is a list
 198 of lines. "
 199
 200
 201   (define MAXPENALTY 1e9)
 202   (define bookpaper (ly:paper-book-book-paper paper-book))
 203   (define scopes (ly:paper-book-scopes paper-book))
 204
 205   (define (page-height page-number last?)
 206     (let
 207         ((p (ly:output-def-lookup bookpaper 'page-music-height)))
 208
 209       (if (procedure? p)
 210           (p bookpaper scopes page-number last?)
 211           10000)))
 212
 213   (define (get-path node done)
 214     "Follow NODE.PREV, and return as an ascending list of pages. DONE
 215 is what have collected so far, and has ascending page numbers."
 216
 217     (if (is-a? node <optimally-broken-page-node>)
 218         (get-path (node-prev node) (cons node done))
 219         done))
 220
 221   (define (combine-penalties force user best-paths)
 222     (let*
 223         ((prev-force  (if (null? best-paths)
 224                           0.0
 225                           (node-force  (car best-paths))))
 226          (prev-penalty (if (null? best-paths)
 227                            0.0
 228                            (node-penalty (car best-paths))))
 229          (inter-system-space (ly:output-def-lookup bookpaper 'betweensystemspace))
 230          (force-equalization-factor 0.3)
 231          (relative-force (/ force inter-system-space))
 232          (abs-relative-force (abs relative-force))
 233          )
 234
 235
 236     (+ (* abs-relative-force (+ abs-relative-force 1))
 237        prev-penalty
 238        (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space))
 239        user)))
 240
 241   (define (space-systems page-height lines ragged?)
 242     (let*
 243         ((inter-system-space
 244           (ly:output-def-lookup bookpaper 'betweensystemspace))
 245          (system-vector (list->vector
 246            (append lines
 247                    (if (= (length lines) 1)
 248                        '(#f)
 249                         '()))
 250            ))
 251
 252          (staff-extents
 253           (list->vector
 254            (append  (map
 255                      ly:paper-system-staff-extents
 256                      lines)
 257                     (if (= (length lines) 1)
 258                         '((0 .  0))
 259                         '()))
 260            ))
 261          (real-extents
 262           (list->vector
 263            (append
 264             (map
 265              (lambda (sys) (ly:paper-system-extent sys Y)) lines)
 266                     (if (= (length lines) 1)
 267                         '((0 .  0))
 268                         '())
 269                     )))
 270          (no-systems (vector-length real-extents))
 271          (topskip (cdr (vector-ref real-extents 0)))
 272          (space-left (- page-height
 273                         (apply + (map interval-length (vector->list real-extents)))
 274
 275                         ))
 276
 277          (space (- page-height
 278                    topskip
 279                    (-  (car (vector-ref real-extents (1- no-systems))))
 280                    ))
 281
 282          (fixed-dist (ly:output-def-lookup bookpaper 'betweensystempadding))
 283          (calc-spring
 284           (lambda (idx)
 285             (let*
 286                 ((this-system-ext (vector-ref staff-extents idx))
 287                  (next-system-ext (vector-ref staff-extents (1+ idx)))
 288                  (fixed (max 0  (- (+ (cdr next-system-ext)
 289                                       fixed-dist)
 290                                    (car this-system-ext))))
 291                  (title1? (and (vector-ref system-vector idx)
 292                                (ly:paper-system-title? (vector-ref system-vector idx))))
 293                  (title2? (and
 294                             (vector-ref system-vector (1+ idx))
 295                             (ly:paper-system-title? (vector-ref system-vector (1+ idx)))))
 296                  (ideal (+
 297                          (cond
 298                           ((and title2? title1?)
 299                            (ly:output-def-lookup bookpaper 'betweentitlespace))
 300                           (title1?
 301                            (ly:output-def-lookup bookpaper 'aftertitlespace))
 302                           (title2?
 303                            (ly:output-def-lookup bookpaper 'beforetitlespace))
 304                           (else inter-system-space))
 305                          fixed))
 306                  (hooke (/ 1 (- ideal fixed)))
 307                  )
 308               (list ideal hooke))
 309             ))
 310
 311          (springs (map calc-spring (iota (1- no-systems))))
 312          (calc-rod
 313           (lambda (idx)
 314             (let*
 315                 ((this-system-ext (vector-ref real-extents idx))
 316                  (next-system-ext (vector-ref real-extents (1+ idx)))
 317                  (distance (max  (- (+ (cdr next-system-ext)
 318                                  fixed-dist)
 319                                     (car this-system-ext)
 320                                     ) 0))
 321                  (entry (list idx (1+ idx) distance)))
 322               entry)))
 323          (rods (map calc-rod (iota (1- no-systems))))
 324          (page-very-empty? (> space-left (/ page-height 3)))
 325          (result (ly:solve-spring-rod-problem
 326                   springs rods space
 327                   (or page-very-empty? ragged?)))
 328          (force (car (if page-very-empty?
 329                          (ly:solve-spring-rod-problem
 330                           springs rods space ragged?)
 331                          result)))
 332          (positions
 333           (map (lambda (y)
 334                        (+ y topskip))
 335                (cdr  result)))
 336          )
 337
 338      (if #f ;; debug.
 339          (begin
 340            (display (list "\n# systems: " no-systems
 341                           "\nreal-ext" real-extents "\nstaff-ext" staff-extents
 342                           "\ninterscore" inter-system-space
 343                           "\nspace-letf" space-left
 344                           "\npage empty" page-very-empty?
 345                           "\nspring,rod" springs rods
 346                           "\ntopskip " topskip
 347                           " space " space
 348                           "\npage-height" page-height
 349                           "\nragged" ragged?
 350                           "\nforce" force
 351                           "\nres" (cdr result)
 352                           "\npositions" positions "\n"))))
 353
 354      (cons force positions)))
 355
 356   (define (walk-paths done-lines best-paths current-lines  last? current-best)
 357     "Return the best optimal-page-break-node that contains
 358 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
 359 ascending range of lines, and BEST-PATHS contains the optimal breaks
 360 corresponding to DONE-LINES.
 361
 362 CURRENT-BEST is the best result sofar, or #f."
 363
 364     (let* ((this-page-num (if (null? best-paths)
 365                               (ly:output-def-lookup bookpaper 'firstpagenumber)
 366                               (1+ (node-page-number (car best-paths)))))
 367
 368
 369            (ragged? (or (eq? #t (ly:output-def-lookup bookpaper 'raggedbottom))
 370                        (and (eq? #t (ly:output-def-lookup bookpaper 'raggedlastbottom))
 371                             last?)))
 372            (page-height (page-height this-page-num last?))
 373            (vertical-spacing (space-systems page-height current-lines ragged?))
 374            (satisfied-constraints (car vertical-spacing))
 375            (force (if satisfied-constraints satisfied-constraints 10000))
 376            (positions (cdr vertical-spacing))
 377            (user-penalty (ly:paper-system-break-penalty (car current-lines)))
 378            (total-penalty (combine-penalties
 379                            force user-penalty
 380                            best-paths))
 381
 382
 383            (better? (or
 384                      (not current-best)
 385                      (< total-penalty (node-penalty current-best))))
 386            (new-best (if better?
 387                          (make <optimally-broken-page-node>
 388                            #:prev  (if (null? best-paths)
 389                                         #f
 390                                         (car best-paths))
 391                            #:lines current-lines
 392                            #:pageno this-page-num
 393                            #:force force
 394                            #:configuration positions
 395                            #:penalty total-penalty)
 396                          current-best)))
 397
 398       (if #f ;; debug
 399           (display
 400            (list
 401             "\nuser pen " user-penalty
 402             "\nsatisfied-constraints" satisfied-constraints
 403             "\nlast? " last? "ragged?" ragged?
 404             "\nbetter? " better? " total-penalty " total-penalty "\n"
 405             "\nconfig " positions
 406             "\nforce " force
 407             "\nlines: " current-lines "\n")))
 408
 409       (if #f ; debug
 410           (display (list "\nnew-best is " (node-lines new-best)
 411                          "\ncontinuation of "
 412                          (if (null? best-paths)
 413                              "start"
 414                              (node-lines (car best-paths))))))
 415
 416       (if (and (pair? done-lines)
 417                ;; if this page is too full, adding another line won't help
 418                satisfied-constraints)
 419           (walk-paths (cdr done-lines) (cdr best-paths)
 420                       (cons (car done-lines) current-lines)
 421                       last? new-best)
 422
 423           new-best)))
 424
 425   (define (walk-lines done best-paths todo)
 426     "Return the best page breaking as a single
 427 <optimal-page-break-node> for optimally breaking TODO ++
 428 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 429 DONE."
 430     (if (null? todo)
 431         (car best-paths)
 432         (let* ((this-line (car todo))
 433                (last? (null? (cdr todo)))
 434                (next (walk-paths done best-paths (list this-line) last? #f)))
 435
 436 ;         (display "\n***************")
 437           (walk-lines (cons this-line done)
 438                       (cons next best-paths)
 439                       (cdr todo)))))
 440
 441   (define (line-number node)
 442     (ly:paper-system-number (car (node-lines node))))
 443
 444   (let* ((best-break-node (walk-lines '() '() lines))
 445          (break-nodes (get-path best-break-node '())))
 446
 447     (if #f; (ly:get-option 'verbose)
 448         (begin
 449           (display (list
 450                     "\nbreaks: " (map line-number break-nodes))
 451                     "\nsystems " (map node-lines break-nodes)
 452                     "\npenalties " (map node-penalty break-nodes)
 453                     "\nconfigs " (map node-configuration break-nodes))))
 454
 455
 456     ; create stencils.
 457
 458     (map (lambda (node)
 459            ((ly:output-def-lookup bookpaper 'page-make-stencil)
 460             (node-lines node)
 461             (node-configuration node)
 462             bookpaper
 463             scopes
 464             (node-page-number node)
 465             (eq? node best-break-node)))
 466          break-nodes)))
 467
 468