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