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