X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scm%2Fpage-layout.scm;h=98044b870ddbaef42965d03c6a57f652eb9f07ac;hb=7e5826578e2218cb1a2c91906614ca6ff648c2ed;hp=1a00c37bdc92dc301b86f3e8d2eb91d2b1961866;hpb=8fc0b9a4a716de24d4764f9f7be386341f1d9768;p=lilypond.git diff --git a/scm/page-layout.scm b/scm/page-layout.scm index 1a00c37bdc..98044b870d 100644 --- a/scm/page-layout.scm +++ b/scm/page-layout.scm @@ -1,8 +1,8 @@ -;;; page-layout.scm -- page breaking and page layout -;;; +;;;; page-layout.scm -- page breaking and page layout +;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004 Jan Nieuwenhuizen +;;;; (c) 2004--2005 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys (use-modules (oop goops describe) @@ -14,7 +14,9 @@ (define-class () (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev) (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno) + (force #:init-value 0 #:accessor node-force #:init-keyword #:force) (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty) + (configuration #:init-value '() #:accessor node-configuration #:init-keyword #:configuration) (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines)) (define-method (display (node ) port) @@ -25,234 +27,306 @@ " Penalty " (node-penalty node) "\n"))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(define TAGLINE - (string-append "Engraved by LilyPond (version " (lilypond-version) ")")) - -;; TODO: take iso. page-number -;; for all of these functions ? - -(define-public (plain-header paper scopes page-number last?) - "Standard header for a part: page number --outside-- and instrument--centered." - - (let* ((props (page-properties paper) ) - (pnum (markup #:bold (number->string page-number))) - (instr (ly:modules-lookup scopes 'instrument)) - (line (list "" (if (markup? instr) instr "") pnum))) - - (if (even? page-number) - (set! line (reverse line))) - - (if (< 1 page-number) - (interpret-markup - paper props (make-fill-line-markup line)) - '()) - )) +(define-method (node-system-numbers (node )) + (map ly:paper-system-number (node-lines node))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TODO: add publisher ID on non-first page. -(define-public (plain-footer paper scopes page-number last?) - "Standard footer. Empty, save for first (copyright) and last (tagline) page." - - (let* - ((props (page-properties paper)) - (copyright (ly:modules-lookup scopes 'copyright)) - (tagline-var (ly:modules-lookup scopes 'tagline)) - (tagline (if (markup? tagline-var) tagline-var TAGLINE)) - (stencil #f)) - - (if last? - (set! stencil - (ly:stencil-combine-at-edge - stencil Y DOWN (interpret-markup paper props tagline) - 0.0 - ))) - - (if (and (= 1 page-number) - (markup? copyright)) - - (set! stencil - (ly:stencil-combine-at-edge - stencil Y DOWN (interpret-markup paper props copyright) - 0.0 - ))) - - stencil)) - -(define (page-headfoot paper scopes number sym sepsym dir last?) +(define (page-headfoot layout scopes number sym sepsym dir last?) "Create a stencil including separating space." - (let* - ((header-proc (ly:output-def-lookup paper sym)) - (sep (ly:output-def-lookup paper sepsym)) + (let* ((header-proc (ly:output-def-lookup layout sym)) + (sep (ly:output-def-lookup layout sepsym)) (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0))) (head-stencil (if (procedure? header-proc) - (header-proc paper scopes number last?) + (header-proc layout scopes number last?) #f))) - (if (and (number? sep) (ly:stencil? head-stencil)) + (if (and (number? sep) + (ly:stencil? head-stencil) + (not (ly:stencil-empty? head-stencil))) (set! head-stencil (ly:stencil-combine-at-edge - stencil Y dir head-stencil + stencil Y dir head-stencil sep 0.0))) head-stencil)) -(define-public (default-page-music-height paper scopes number last?) - "Printable area for music and titles; matches default-page-make-stencil." - (let* - ((h (- (ly:output-def-lookup paper 'vsize) - (ly:output-def-lookup paper 'top-margin) - (ly:output-def-lookup paper 'bottom-margin))) - (head (page-headfoot paper scopes number 'make-header 'head-sep UP last?)) - (foot (page-headfoot paper scopes number 'make-footer 'foot-sep DOWN last?))) - (- h (if (ly:stencil? head) - (interval-length (ly:stencil-extent head Y)) - 0) - (if (ly:stencil? foot) - (interval-length (ly:stencil-extent foot Y)) - 0)) - )) - - -(define-public (default-page-make-stencil lines paper scopes number last? ) - "Construct a stencil representing the page from LINES. " - (let* - ((top-margin (ly:output-def-lookup paper 'top-margin)) - - ;; TODO: naming vsize/hsize not analogous to TeX. - - (hsize (ly:output-def-lookup paper 'hsize)) - (left-margin (/ (- hsize - (ly:output-def-lookup paper 'linewidth)) 2)) - (vsize (ly:output-def-lookup paper 'vsize)) - (bottom-edge (- vsize - (ly:output-def-lookup paper 'bottom-margin))) - - (head (page-headfoot paper scopes number 'make-header 'head-sep UP last?)) - (foot (page-headfoot paper scopes number 'make-footer 'foot-sep DOWN last?)) - (line-stencils (map ly:paper-system-stencil lines)) - (height-proc (ly:output-def-lookup paper 'page-music-height)) - (music-height (height-proc paper scopes number last?)) - (ragged (ly:output-def-lookup paper 'raggedbottom)) - (ragged-last (ly:output-def-lookup paper 'raggedlastbottom)) - (ragged-bottom (or (eq? #t ragged) - (and last? (eq? #t ragged-last)))) - - (spc-left (- music-height - (apply + (map (lambda (x) - (interval-length (ly:stencil-extent x Y))) - line-stencils)))) - (stretchable-lines (remove ly:paper-system-title? (cdr lines))) - (stretch (if (or (null? stretchable-lines) - (> spc-left (/ music-height 2)) - ragged-bottom) - 0.0 - (/ spc-left (length stretchable-lines)))) - - (page-stencil (ly:make-stencil '() - (cons left-margin hsize) - (cons (- top-margin) 0))) - (was-title #t)) +(define-public (default-page-music-height layout scopes number last?) + "Printable area for music and titles; matches default-page-make-stencil." + (let* ((h (- (ly:output-def-lookup layout 'vsize) + (ly:output-def-lookup layout 'topmargin) + (ly:output-def-lookup layout 'bottommargin))) + (head (page-headfoot layout scopes number 'make-header 'headsep UP last?)) + (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?)) + (available + (- h (if (ly:stencil? head) + (interval-length (ly:stencil-extent head Y)) + 0) + (if (ly:stencil? foot) + (interval-length (ly:stencil-extent foot Y)) + 0)))) + + ;; (display (list "\n available" available head foot)) + available)) + +(define-public (default-page-make-stencil + lines offsets layout scopes number last?) + "Construct a stencil representing the page from LINES. + + Offsets is a list of increasing numbers. They must be negated to +create offsets. + " + + (let* ((topmargin (ly:output-def-lookup layout 'topmargin)) + + ;; TODO: naming vsize/hsize not analogous to TeX. + + (vsize (ly:output-def-lookup layout 'vsize)) + (hsize (ly:output-def-lookup layout 'hsize)) + + (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0)) + (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup)) + (system-separator-stencil (if (markup? system-separator-markup) + (interpret-markup layout + (layout-extract-page-properties layout) + system-separator-markup) + #f)) + (lmargin (ly:output-def-lookup layout 'leftmargin)) + (leftmargin (if lmargin + lmargin + (/ (- hsize + (ly:output-def-lookup layout 'linewidth)) 2))) + + (rightmargin (ly:output-def-lookup layout 'rightmargin)) + (bottom-edge (- vsize + (ly:output-def-lookup layout 'bottommargin))) + + (head (page-headfoot layout scopes number 'make-header 'headsep UP last?)) + (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?)) + + (head-height (if (ly:stencil? head) + (interval-length (ly:stencil-extent head Y)) + 0.0)) + + (height-proc (ly:output-def-lookup layout 'page-music-height)) + + (page-stencil (ly:make-stencil '() + (cons leftmargin hsize) + (cons (- topmargin) 0))) + (last-system #f) + (last-y 0.0) + (add-to-page (lambda (stencil y) + (set! page-stencil + (ly:stencil-add page-stencil + (ly:stencil-translate stencil + (cons + system-xoffset + (- 0 head-height y topmargin)) + + ))))) + (add-system + (lambda (stencil-position) + (let* ((system (car stencil-position)) + (stencil (ly:paper-system-stencil system)) + (y (cadr stencil-position)) + (is-title (ly:paper-system-title? + (car stencil-position)))) + (add-to-page stencil y) + (if (and (ly:stencil? system-separator-stencil) + last-system + (not (ly:paper-system-title? system)) + (not (ly:paper-system-title? last-system))) + (add-to-page + system-separator-stencil + (average (- last-y + (car (ly:paper-system-staff-extents last-system))) + (- y + (cdr (ly:paper-system-staff-extents system)))))) + (set! last-system system) + (set! last-y y))))) + + (if #f + (display (list + "leftmargin " leftmargin "rightmargin " rightmargin + ))) (set! page-stencil (ly:stencil-combine-at-edge - page-stencil Y DOWN head 0. 0.)) - - (for-each - (lambda (l) - (set! page-stencil - (ly:stencil-combine-at-edge - page-stencil Y DOWN (ly:paper-system-stencil l) - (if was-title - 0.0 - stretch) - )) - - (set! was-title (ly:paper-system-title? l))) - lines) - - (if (ly:stencil? foot) + page-stencil Y DOWN + (if (and + (ly:stencil? head) + (not (ly:stencil-empty? head))) + head + (ly:make-stencil "" (cons 0 0) (cons 0 0))) + 0. 0.)) + + (map add-system (zip lines offsets)) + (if (and (ly:stencil? foot) + (not (ly:stencil-empty? foot))) (set! page-stencil (ly:stencil-add page-stencil (ly:stencil-translate foot (cons 0 - (+ (- bottom-edge) (- (car (ly:stencil-extent foot Y))))) - )))) - - (ly:stencil-translate page-stencil (cons left-margin 0)) - )) - - + (+ (- bottom-edge) + (- (car (ly:stencil-extent foot Y))))))))) + (ly:stencil-translate page-stencil (cons leftmargin 0)))) ;;; optimal page breaking ;;; This is not optimal page breaking, this is optimal distribution of ;;; lines over pages; line breaks are a given. -; TODO: -; -; - density scoring -; - separate function for word-wrap style breaking? -; - raggedbottom? raggedlastbottom? +;; TODO: +;; +;; - density scoring +;; - separate function for word-wrap style breaking? +;; - raggedbottom? raggedlastbottom? (define-public (ly:optimal-page-breaks lines paper-book) "Return pages as a list starting with 1st page. Each page is a list of lines. " - (define (make-node prev lines page-num penalty) - (make - #:prev prev - #:lines lines - #:pageno page-num - #:penalty penalty)) (define MAXPENALTY 1e9) - (define bookpaper (ly:paper-book-book-paper paper-book)) + (define paper (ly:paper-book-paper paper-book)) (define scopes (ly:paper-book-scopes paper-book)) - (define (line-height line) - (ly:paper-system-extent line Y)) - - ;; FIXME: may need some tweaking: square, cubic - (define (height-penalty available used) - ;; FIXME, simplistic - (let* ((left (- available used)) - ;; scale-independent - (relative (abs (/ left available)))) - (if (negative? left) - - ;; too full, penalise more - (* 10 (1+ relative) relative) - - ;; Convexity: two half-empty pages is better than 1 completely - ;; empty page - (* (1+ relative) relative)))) + (define force-equalization-factor #f) (define (page-height page-number last?) - (let - ((p (ly:output-def-lookup bookpaper 'page-music-height))) + (let ((p (ly:output-def-lookup paper 'page-music-height))) (if (procedure? p) - (p bookpaper scopes page-number last?) + (p paper scopes page-number last?) 10000))) - - (define (cumulative-height lines) - (apply + (map line-height lines))) - (define (get-path node done) "Follow NODE.PREV, and return as an ascending list of pages. DONE is what have collected so far, and has ascending page numbers." + (if (is-a? node ) (get-path (node-prev node) (cons node done)) done)) - (define (combine-penalties user page prev) - (+ prev page user)) + (define (combine-penalties force user best-paths) + (let* ((prev-force (if (null? best-paths) + 0.0 + (node-force (car best-paths)))) + (prev-penalty (if (null? best-paths) + 0.0 + (node-penalty (car best-paths)))) + (inter-system-space (ly:output-def-lookup paper 'betweensystemspace)) + (relative-force (/ force inter-system-space)) + (abs-relative-force (abs relative-force))) + + + (+ (* abs-relative-force (+ abs-relative-force 1)) + prev-penalty + (* force-equalization-factor (/ (abs (- prev-force force)) + inter-system-space)) + user))) + + (define (space-systems page-height lines ragged?) + (let* ((inter-system-space + (ly:output-def-lookup paper 'betweensystemspace)) + (system-vector (list->vector + (append lines + (if (= (length lines) 1) + '(#f) + '())))) + (staff-extents + (list->vector + (append (map ly:paper-system-staff-extents lines) + (if (= (length lines) 1) + '((0 . 0)) + '())))) + (real-extents + (list->vector + (append + (map + (lambda (sys) (ly:paper-system-extent sys Y)) lines) + (if (= (length lines) 1) + '((0 . 0)) + '())))) + (no-systems (vector-length real-extents)) + (topskip (interval-end (vector-ref real-extents 0))) + (space-left (- page-height + (apply + (map interval-length (vector->list real-extents))))) + + (space (- page-height + topskip + (- (interval-start (vector-ref real-extents (1- no-systems)))))) + + (fixed-dist (ly:output-def-lookup paper 'betweensystempadding)) + (calc-spring + (lambda (idx) + (let* ((this-system-ext (vector-ref staff-extents idx)) + (next-system-ext (vector-ref staff-extents (1+ idx))) + (fixed (max 0 (- (+ (interval-end next-system-ext) + fixed-dist) + (interval-start this-system-ext)))) + (title1? (and (vector-ref system-vector idx) + (ly:paper-system-title? (vector-ref system-vector idx)))) + (title2? (and + (vector-ref system-vector (1+ idx)) + (ly:paper-system-title? (vector-ref system-vector (1+ idx))))) + (ideal (+ + (cond + ((and title2? title1?) + (ly:output-def-lookup paper 'betweentitlespace)) + (title1? + (ly:output-def-lookup paper 'aftertitlespace)) + (title2? + (ly:output-def-lookup paper 'beforetitlespace)) + (else inter-system-space)) + fixed)) + (hooke (/ 1 (- ideal fixed)))) + (list ideal hooke)))) + + (springs (map calc-spring (iota (1- no-systems)))) + (calc-rod + (lambda (idx) + (let* ((this-system-ext (vector-ref real-extents idx)) + (next-system-ext (vector-ref real-extents (1+ idx))) + (distance (max (- (+ (interval-end next-system-ext) + fixed-dist) + (interval-start this-system-ext) + ) 0)) + (entry (list idx (1+ idx) distance))) + entry))) + (rods (map calc-rod (iota (1- no-systems)))) + + ;; we don't set ragged based on amount space left. + ;; raggedbottomlast = ##T is much more predictable + (result (ly:solve-spring-rod-problem + springs rods space + ragged?)) + + (force (car result)) + (positions + (map (lambda (y) + (+ y topskip)) + (cdr result)))) + + (if #f ;; debug. + (begin + (display (list "\n# systems: " no-systems + "\nreal-ext" real-extents "\nstaff-ext" staff-extents + "\ninterscore" inter-system-space + "\nspace-letf" space-left + "\nspring,rod" springs rods + "\ntopskip " topskip + " space " space + "\npage-height" page-height + "\nragged" ragged? + "\nforce" force + "\nres" (cdr result) + "\npositions" positions "\n")))) + + (cons force positions))) (define (walk-paths done-lines best-paths current-lines last? current-best) "Return the best optimal-page-break-node that contains @@ -262,44 +336,79 @@ corresponding to DONE-LINES. CURRENT-BEST is the best result sofar, or #f." - (let* ((this-page-num (if (null? best-paths) - 1 - (1+ (node-page-number (car best-paths))))) - (prev-penalty (if (null? best-paths) - 0.0 - (node-penalty (car best-paths)))) - (page-height (page-height this-page-num last?)) - (space-used (cumulative-height current-lines)) - (this-page-penalty (height-penalty page-height space-used)) - (user-penalty (ly:paper-system-break-penalty (car current-lines))) - (total-penalty (combine-penalties - user-penalty this-page-penalty prev-penalty)) - (better? (or - (not current-best) - (< total-penalty (node-penalty current-best)))) - (new-best (if better? - (make-node (if (null? best-paths) - #f - (car best-paths)) - current-lines - this-page-num total-penalty) - current-best))) + (let* ((this-page-num (if (null? best-paths) + (ly:output-def-lookup paper 'firstpagenumber) + (1+ (node-page-number (car best-paths))))) + + (ragged-all? (eq? #t (ly:output-def-lookup paper 'raggedbottom))) + (ragged-last? (eq? #t (ly:output-def-lookup paper 'raggedlastbottom))) + (ragged? (or ragged-all? + (and ragged-last? + last?))) + (page-height (page-height this-page-num last?)) + (vertical-spacing (space-systems page-height current-lines ragged?)) + (satisfied-constraints (car vertical-spacing)) + (force (if satisfied-constraints + (if (and last? ragged-last?) + 0.0 + satisfied-constraints) + 10000)) + (positions (cdr vertical-spacing)) + (user-nobreak-penalties + (- + (apply + (filter negative? + (map ly:paper-system-break-before-penalty + (cdr current-lines)))))) + (user-penalty + (+ + (max (ly:paper-system-break-before-penalty (car current-lines)) 0.0) + user-nobreak-penalties)) + (total-penalty (combine-penalties + force user-penalty + best-paths)) + + + (better? (or + (not current-best) + (< total-penalty (node-penalty current-best)))) + (new-best (if better? + (make + #:prev (if (null? best-paths) + #f + (car best-paths)) + #:lines current-lines + #:pageno this-page-num + #:force force + #:configuration positions + #:penalty total-penalty) + current-best))) + +;; (display total-penalty) (newline) (if #f ;; debug - (display - (list - "user pen " user-penalty " prev-penalty " - prev-penalty "\n" - "better? " better? " total-penalty " total-penalty "\n" - "height " page-height " spc used: " space-used "\n" - "pen " this-page-penalty " lines: " current-lines "\n"))) + (display + (list + "\nuser pen " user-penalty + "\nsatisfied-constraints" satisfied-constraints + "\nlast? " last? "ragged?" ragged? + "\nbetter? " better? " total-penalty " total-penalty "\n" + "\nconfig " positions + "\nforce " force + "\nlines: " current-lines "\n"))) + + (if #f ; debug + (display (list "\nnew-best is " (node-lines new-best) + "\ncontinuation of " + (if (null? best-paths) + "start" + (node-lines (car best-paths)))))) (if (and (pair? done-lines) - ;; if this page is too full, adding another line won't help - (< this-page-penalty MAXPENALTY)) - (walk-paths (cdr done-lines) (cdr best-paths) - (cons (car done-lines) current-lines) - last? new-best) + ;; if this page is too full, adding another line won't help + satisfied-constraints) + (walk-paths (cdr done-lines) (cdr best-paths) + (cons (car done-lines) current-lines) + last? new-best) new-best))) (define (walk-lines done best-paths todo) @@ -312,7 +421,8 @@ DONE." (let* ((this-line (car todo)) (last? (null? (cdr todo))) (next (walk-paths done best-paths (list this-line) last? #f))) - + + ;; (display "\n***************") (walk-lines (cons this-line done) (cons next best-paths) (cdr todo))))) @@ -320,25 +430,40 @@ DONE." (define (line-number node) (ly:paper-system-number (car (node-lines node)))) + (ly:message (_ "Calculating page breaks...")) + (set! force-equalization-factor + (ly:output-def-lookup paper 'verticalequalizationfactor 0.3)) + (let* ((best-break-node (walk-lines '() '() lines)) (break-nodes (get-path best-break-node '())) - ) - - (if (ly:get-option 'verbose) + (last-node (car (last-pair break-nodes)))) + + (define (node->page-stencil node) + (if (not (eq? node last-node)) + (ly:progress "[")) + (let ((stencil + ((ly:output-def-lookup paper 'page-make-stencil) + (node-lines node) + (node-configuration node) + paper + scopes + (node-page-number node) + (eq? node best-break-node)))) + (if (not (eq? node last-node)) + (begin + (ly:progress (number->string + (car (last-pair (node-system-numbers node))))) + (ly:progress "]"))) + stencil)) + + (if #f; (ly:get-option 'verbose) (begin - (format (current-error-port) "breaks: ~S\n" (map line-number break-nodes)) - (force-output (current-error-port)))) - - - ; create stencils. - - (map (lambda (node) - ((ly:output-def-lookup bookpaper 'page-make-stencil) - (node-lines node) - bookpaper - scopes - (node-page-number node) - (eq? node best-break-node))) - break-nodes))) - - + (display (list + "\nbreaks: " (map line-number break-nodes)) + "\nsystems " (map node-lines break-nodes) + "\npenalties " (map node-penalty break-nodes) + "\nconfigs " (map node-configuration break-nodes)))) + + (let ((stencils (map node->page-stencil break-nodes))) + (ly:progress "\n") + stencils)))