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