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       (spc-left (-  music-height
 139                    (apply + (map (lambda (x)
 140                                    (interval-length (ly:stencil-extent x Y)))
 141                         line-stencils))))
 142       (stretchable-lines (remove ly:paper-system-title? (cdr lines)))
 143       (stretch (if (null? stretchable-lines)
 144                    0.0
 145                    (/ spc-left (length stretchable-lines))))
 146
 147       (page-stencil (ly:make-stencil '()
 148                     (cons left-margin hsize)
 149                     (cons (- top-margin) 0)))
 150       (was-title #t))
 151
 152     (set! page-stencil (ly:stencil-combine-at-edge
 153           page-stencil Y DOWN head 0. 0.))
 154
 155     (for-each
 156      (lambda (l)
 157        (set! page-stencil
 158              (ly:stencil-combine-at-edge
 159               page-stencil Y DOWN (ly:paper-system-stencil l)
 160               (if was-title
 161                   0.0
 162                   stretch)
 163               ))
 164
 165        (set! was-title (ly:paper-system-title? l)))
 166      lines)
 167
 168     (if (ly:stencil? foot)
 169         (set! page-stencil
 170               (ly:stencil-add
 171                page-stencil
 172                (ly:stencil-translate
 173                 foot
 174                 (cons 0
 175                       (+ (- bottom-edge) (- (car (ly:stencil-extent foot Y)))))
 176                 ))))
 177
 178     (ly:stencil-translate page-stencil (cons left-margin 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   (define (make-node prev lines page-num penalty)
 201     (make <optimally-broken-page-node>
 202       #:prev prev
 203       #:lines lines
 204       #:pageno page-num
 205       #:penalty penalty))
 206
 207   (define MAXPENALTY 1e9)
 208   (define bookpaper (ly:paper-book-book-paper paper-book))
 209   (define scopes (ly:paper-book-scopes paper-book))
 210   (define (line-height line)
 211     (ly:paper-system-extent line Y))
 212
 213   ;; FIXME: may need some tweaking: square, cubic
 214   (define (height-penalty available used)
 215     ;; FIXME, simplistic
 216     (let* ((left (- available used))
 217            ;; scale-independent
 218            (relative (abs (/ left available))))
 219       (if (negative? left)
 220
 221           ;; too full, penalise more
 222           (* 10 (1+ relative) relative)
 223
 224           ;; Convexity: two half-empty pages is better than 1 completely
 225           ;; empty page
 226           (* (1+ relative) relative))))
 227
 228   (define (page-height page-number last?)
 229     (let
 230         ((p (ly:output-def-lookup bookpaper 'page-music-height)))
 231
 232       (if (procedure? p)
 233           (p bookpaper scopes page-number last?)
 234           10000)))
 235
 236
 237   (define (cumulative-height lines)
 238     (apply + (map line-height lines)))
 239
 240   (define (get-path node done)
 241     "Follow NODE.PREV, and return as an ascending list of pages. DONE
 242 is what have collected so far, and has ascending page numbers."
 243     (if (is-a? node <optimally-broken-page-node>)
 244         (get-path (node-prev node) (cons node done))
 245         done))
 246
 247   (define (combine-penalties user page prev)
 248     (+ prev page user))
 249
 250   (define (walk-paths done-lines best-paths current-lines  last? current-best)
 251     "Return the best optimal-page-break-node that contains
 252 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
 253 ascending range of lines, and BEST-PATHS contains the optimal breaks
 254 corresponding to DONE-LINES.
 255
 256 CURRENT-BEST is the best result sofar, or #f."
 257
 258     (let* ((this-page-num (if (null? best-paths)
 259                               1
 260                               (1+ (node-page-number (car best-paths)))))
 261            (prev-penalty (if (null? best-paths)
 262                              0.0
 263                              (node-penalty (car best-paths))))
 264            (page-height (page-height this-page-num last?))
 265            (space-used (cumulative-height current-lines))
 266            (this-page-penalty (height-penalty  page-height space-used))
 267            (user-penalty (ly:paper-system-break-penalty (car current-lines)))
 268            (total-penalty (combine-penalties
 269                            user-penalty this-page-penalty prev-penalty))
 270            (better? (or
 271                      (not current-best)
 272                      (< total-penalty (node-penalty current-best))))
 273            (new-best (if better?
 274                          (make-node (if (null? best-paths)
 275                                         #f
 276                                         (car best-paths))
 277                                     current-lines
 278                                     this-page-num total-penalty)
 279                          current-best)))
 280
 281       (if #f ;; debug
 282           (display
 283            (list
 284             "user pen " user-penalty " prev-penalty "
 285             prev-penalty "\n"
 286             "better? " better? " total-penalty " total-penalty "\n"
 287             "height " page-height " spc used: " space-used "\n"
 288             "pen " this-page-penalty " lines: " current-lines "\n")))
 289
 290       (if (and (pair? done-lines)
 291                ;; if this page is too full, adding another line won't help
 292                (< this-page-penalty MAXPENALTY))
 293           (walk-paths (cdr done-lines) (cdr best-paths)
 294                       (cons (car done-lines) current-lines)
 295                       last? new-best)
 296           new-best)))
 297
 298   (define (walk-lines done best-paths todo)
 299     "Return the best page breaking as a single
 300 <optimal-page-break-node> for optimally breaking TODO ++
 301 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 302 DONE."
 303     (if (null? todo)
 304         (car best-paths)
 305         (let* ((this-line (car todo))
 306                (last? (null? (cdr todo)))
 307                (next (walk-paths done best-paths (list this-line) last? #f)))
 308
 309           (walk-lines (cons this-line done)
 310                       (cons next best-paths)
 311                       (cdr todo)))))
 312
 313   (define (line-number node)
 314     (ly:paper-system-number (car (node-lines node))))
 315
 316   (let* ((best-break-node (walk-lines '() '() lines))
 317          (break-nodes (get-path best-break-node '()))
 318          )
 319
 320     (if (ly:get-option 'verbose)
 321         (begin
 322           (format (current-error-port) "breaks: ~S\n" (map line-number break-nodes))
 323           (force-output (current-error-port))))
 324
 325
 326     ; create stencils.
 327
 328     (map (lambda (node)
 329            ((ly:output-def-lookup bookpaper 'page-make-stencil)
 330             (node-lines node)
 331             bookpaper
 332             scopes
 333             (node-page-number node)
 334             (eq? node best-break-node)))
 335          break-nodes)))
 336
 337