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   (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty)
  18   (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
  19
  20 (define-method (display (node <optimally-broken-page-node>) port)
  21   (map (lambda (x) (display x port))
  22        (list
  23         "Page " (node-page-number node)
  24         " Lines: " (node-lines node)
  25         " Penalty " (node-penalty node)
  26         "\n")))
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29
  30 (define TAGLINE
  31   (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
  32
  33 ;; TODO: take <optimally-broken-page-node> iso. page-number
  34 ;; for all of these functions ?
  35
  36 (define-public (plain-header paper scopes page-number last?)
  37   "Standard header for a part: page number --outside--  and instrument--centered."
  38
  39   (let* ((props (page-properties paper) )
  40          (pnum (markup #:bold (number->string page-number)))
  41          (instr (ly:modules-lookup scopes 'instrument))
  42          (line (list "" (if (markup? instr) instr "") pnum)))
  43
  44     (if (even? page-number)
  45         (set! line (reverse line)))
  46
  47     (if (< 1 page-number)
  48         (interpret-markup
  49          paper props (make-fill-line-markup line))
  50         '())
  51     ))
  52
  53
  54 ;; TODO: add publisher ID on non-first page.
  55 (define-public (plain-footer paper scopes page-number last?)
  56   "Standard footer. Empty, save for first (copyright) and last (tagline) page."
  57
  58   (let*
  59       ((props (page-properties paper))
  60        (copyright (ly:modules-lookup scopes 'copyright))
  61        (tagline-var (ly:modules-lookup scopes 'tagline))
  62        (tagline (if (markup? tagline-var) tagline-var TAGLINE))
  63        (stencil #f))
  64
  65     (if last?
  66         (set! stencil
  67               (ly:stencil-combine-at-edge
  68                stencil Y DOWN (interpret-markup paper props tagline)
  69                0.0
  70                )))
  71
  72     (if (and (= 1 page-number)
  73              (markup? copyright))
  74
  75         (set! stencil
  76               (ly:stencil-combine-at-edge
  77                stencil Y DOWN (interpret-markup paper props copyright)
  78                0.0
  79                )))
  80
  81     stencil))
  82
  83 (define (page-headfoot paper scopes number sym sepsym dir last?)
  84   "Create a stencil including separating space."
  85   (let*
  86       ((header-proc (ly:output-def-lookup paper sym))
  87        (sep (ly:output-def-lookup paper sepsym))
  88        (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
  89        (head-stencil
  90         (if (procedure? header-proc)
  91             (header-proc paper scopes number last?)
  92             #f)))
  93
  94     (if (and (number? sep) (ly:stencil? head-stencil))
  95         (set! head-stencil
  96               (ly:stencil-combine-at-edge
  97                stencil Y  dir head-stencil
  98                sep 0.0)))
  99
 100     head-stencil))
 101
 102 (define-public (default-page-music-height paper scopes number last?)
 103   "Printable area for music and titles; matches default-page-make-stencil."
 104   (let*
 105       ((h (- (ly:output-def-lookup paper 'vsize)
 106              (ly:output-def-lookup paper 'top-margin)
 107              (ly:output-def-lookup paper 'bottom-margin)))
 108        (head (page-headfoot paper scopes number 'make-header 'head-sep UP last?))
 109        (foot (page-headfoot paper scopes number 'make-footer 'foot-sep DOWN last?)))
 110     (- h (if (ly:stencil? head)
 111              (interval-length (ly:stencil-extent head Y))
 112              0)
 113        (if (ly:stencil? foot)
 114            (interval-length (ly:stencil-extent foot Y))
 115            0))
 116     ))
 117
 118
 119 (define-public (default-page-make-stencil lines paper scopes number last? )
 120   "Construct a stencil representing the page from LINES.  "
 121   (let*
 122      ((top-margin  (ly:output-def-lookup paper 'top-margin))
 123
 124       ;; TODO: naming vsize/hsize not analogous to TeX.
 125
 126       (hsize (ly:output-def-lookup paper 'hsize))
 127       (left-margin (/ (- hsize
 128                          (ly:output-def-lookup paper 'linewidth)) 2))
 129       (vsize (ly:output-def-lookup paper 'vsize))
 130       (bottom-edge (- vsize
 131                       (ly:output-def-lookup paper 'bottom-margin)))
 132
 133       (head (page-headfoot paper scopes number 'make-header 'head-sep UP last?))
 134       (foot (page-headfoot paper scopes number 'make-footer 'foot-sep DOWN last?))
 135       (line-stencils (map ly:paper-system-stencil lines))
 136       (height-proc (ly:output-def-lookup paper 'page-music-height))
 137       (music-height (height-proc paper scopes number last?))
 138       (ragged (ly:output-def-lookup paper 'raggedbottom))
 139       (ragged-last   (ly:output-def-lookup paper 'raggedlastbottom))
 140       (ragged-bottom (or (eq? #t ragged)
 141                          (and last? (eq? #t ragged-last))))
 142
 143       (spc-left (-  music-height
 144                    (apply + (map (lambda (x)
 145                                    (interval-length (ly:stencil-extent x Y)))
 146                         line-stencils))))
 147       (stretchable-lines (remove ly:paper-system-title? (cdr lines)))
 148       (stretch (if (or (null? stretchable-lines)
 149                        (> spc-left (/ music-height 2))
 150                        ragged-bottom)
 151                    0.0
 152                    (/ spc-left (length stretchable-lines))))
 153
 154       (page-stencil (ly:make-stencil '()
 155                     (cons left-margin hsize)
 156                     (cons (- top-margin) 0)))
 157       (was-title #t))
 158
 159     (set! page-stencil (ly:stencil-combine-at-edge
 160           page-stencil Y DOWN head 0. 0.))
 161
 162     (for-each
 163      (lambda (l)
 164        (set! page-stencil
 165              (ly:stencil-combine-at-edge
 166               page-stencil Y DOWN (ly:paper-system-stencil l)
 167               (if was-title
 168                   0.0
 169                   stretch)
 170               ))
 171
 172        (set! was-title (ly:paper-system-title? l)))
 173      lines)
 174
 175     (if (ly:stencil? foot)
 176         (set! page-stencil
 177               (ly:stencil-add
 178                page-stencil
 179                (ly:stencil-translate
 180                 foot
 181                 (cons 0
 182                       (+ (- bottom-edge) (- (car (ly:stencil-extent foot Y)))))
 183                 ))))
 184
 185     (ly:stencil-translate page-stencil (cons left-margin 0))
 186   ))
 187
 188
 189
 190
 191 ;;; optimal page breaking
 192
 193 ;;; This is not optimal page breaking, this is optimal distribution of
 194 ;;; lines over pages; line breaks are a given.
 195
 196 ; TODO:
 197 ;
 198 ; - density scoring
 199 ; - separate function for word-wrap style breaking?
 200 ; - raggedbottom? raggedlastbottom?
 201
 202 (define-public (ly:optimal-page-breaks
 203                 lines paper-book)
 204   "Return pages as a list starting with 1st page. Each page is a list
 205 of lines. "
 206
 207   (define (make-node prev lines page-num penalty)
 208     (make <optimally-broken-page-node>
 209       #:prev prev
 210       #:lines lines
 211       #:pageno page-num
 212       #:penalty penalty))
 213
 214   (define MAXPENALTY 1e9)
 215   (define bookpaper (ly:paper-book-book-paper paper-book))
 216   (define scopes (ly:paper-book-scopes paper-book))
 217   (define (line-height line)
 218     (ly:paper-system-extent line Y))
 219
 220   ;; FIXME: may need some tweaking: square, cubic
 221   (define (height-penalty available used)
 222     ;; FIXME, simplistic
 223     (let* ((left (- available used))
 224            ;; scale-independent
 225            (relative (abs (/ left available))))
 226       (if (negative? left)
 227
 228           ;; too full, penalise more
 229           (* 10 (1+ relative) relative)
 230
 231           ;; Convexity: two half-empty pages is better than 1 completely
 232           ;; empty page
 233           (* (1+ relative) relative))))
 234
 235   (define (page-height page-number last?)
 236     (let
 237         ((p (ly:output-def-lookup bookpaper 'page-music-height)))
 238
 239       (if (procedure? p)
 240           (p bookpaper scopes page-number last?)
 241           10000)))
 242
 243
 244   (define (cumulative-height lines)
 245     (apply + (map line-height lines)))
 246
 247   (define (get-path node done)
 248     "Follow NODE.PREV, and return as an ascending list of pages. DONE
 249 is what have collected so far, and has ascending page numbers."
 250     (if (is-a? node <optimally-broken-page-node>)
 251         (get-path (node-prev node) (cons node done))
 252         done))
 253
 254   (define (combine-penalties user page prev)
 255     (+ prev page user))
 256
 257   (define (walk-paths done-lines best-paths current-lines  last? current-best)
 258     "Return the best optimal-page-break-node that contains
 259 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
 260 ascending range of lines, and BEST-PATHS contains the optimal breaks
 261 corresponding to DONE-LINES.
 262
 263 CURRENT-BEST is the best result sofar, or #f."
 264
 265     (let* ((this-page-num (if (null? best-paths)
 266                               1
 267                               (1+ (node-page-number (car best-paths)))))
 268            (prev-penalty (if (null? best-paths)
 269                              0.0
 270                              (node-penalty (car best-paths))))
 271            (page-height (page-height this-page-num last?))
 272            (space-used (cumulative-height current-lines))
 273            (this-page-penalty (height-penalty  page-height space-used))
 274            (user-penalty (ly:paper-system-break-penalty (car current-lines)))
 275            (total-penalty (combine-penalties
 276                            user-penalty this-page-penalty prev-penalty))
 277            (better? (or
 278                      (not current-best)
 279                      (< total-penalty (node-penalty current-best))))
 280            (new-best (if better?
 281                          (make-node (if (null? best-paths)
 282                                         #f
 283                                         (car best-paths))
 284                                     current-lines
 285                                     this-page-num total-penalty)
 286                          current-best)))
 287
 288       (if #f ;; debug
 289           (display
 290            (list
 291             "user pen " user-penalty " prev-penalty "
 292             prev-penalty "\n"
 293             "better? " better? " total-penalty " total-penalty "\n"
 294             "height " page-height " spc used: " space-used "\n"
 295             "pen " this-page-penalty " lines: " current-lines "\n")))
 296
 297       (if (and (pair? done-lines)
 298                ;; if this page is too full, adding another line won't help
 299                (< this-page-penalty MAXPENALTY))
 300           (walk-paths (cdr done-lines) (cdr best-paths)
 301                       (cons (car done-lines) current-lines)
 302                       last? new-best)
 303           new-best)))
 304
 305   (define (walk-lines done best-paths todo)
 306     "Return the best page breaking as a single
 307 <optimal-page-break-node> for optimally breaking TODO ++
 308 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 309 DONE."
 310     (if (null? todo)
 311         (car best-paths)
 312         (let* ((this-line (car todo))
 313                (last? (null? (cdr todo)))
 314                (next (walk-paths done best-paths (list this-line) last? #f)))
 315
 316           (walk-lines (cons this-line done)
 317                       (cons next best-paths)
 318                       (cdr todo)))))
 319
 320   (define (line-number node)
 321     (ly:paper-system-number (car (node-lines node))))
 322
 323   (let* ((best-break-node (walk-lines '() '() lines))
 324          (break-nodes (get-path best-break-node '()))
 325          )
 326
 327     (if (ly:get-option 'verbose)
 328         (begin
 329           (format (current-error-port) "breaks: ~S\n" (map line-number break-nodes))
 330           (force-output (current-error-port))))
 331
 332
 333     ; create stencils.
 334
 335     (map (lambda (node)
 336            ((ly:output-def-lookup bookpaper 'page-make-stencil)
 337             (node-lines node)
 338             bookpaper
 339             scopes
 340             (node-page-number node)
 341             (eq? node best-break-node)))
 342          break-nodes)))
 343
 344