X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpage-layout.scm;h=08590f2f89d99865eecb08071f437d122d10cab7;hb=a999ec6e8af5951c122366fc5a80d66cec2ff6f0;hp=26020101159590ef0a8796393add5c7c80f98244;hpb=b036228d715c4f05c52174e66a494a666c302ce8;p=lilypond.git diff --git a/scm/page-layout.scm b/scm/page-layout.scm index 2602010115..08590f2f89 100644 --- a/scm/page-layout.scm +++ b/scm/page-layout.scm @@ -2,7 +2,7 @@ ;;;; ;;;; 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,7 @@ (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) + (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)) @@ -27,10 +27,10 @@ " Penalty " (node-penalty node) "\n"))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-method (node-system-numbers (node )) + (map ly:paper-system-number (node-lines node))) -(define TAGLINE - (string-append "Engraved by LilyPond (version " (lilypond-version) ")")) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (page-headfoot layout scopes number sym sepsym dir last?) "Create a stencil including separating space." @@ -53,20 +53,20 @@ head-stencil)) (define-public (default-page-music-height layout scopes number last?) - "Printable area for music and titles; matches default-page-make-stencil." + "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 + (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)) @@ -77,17 +77,18 @@ 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-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup)) (system-separator-stencil (if (markup? system-separator-markup) (interpret-markup layout - (page-properties layout) + (layout-extract-page-properties layout) system-separator-markup) #f)) (lmargin (ly:output-def-lookup layout 'leftmargin)) @@ -99,7 +100,7 @@ create offsets. (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?)) @@ -119,36 +120,44 @@ create offsets. (ly:stencil-add page-stencil (ly:stencil-translate-axis stencil (- 0 head-height y topmargin) Y))))) - (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))))) + (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))) - + "leftmargin " leftmargin "rightmargin " rightmargin + ))) + (set! page-stencil (ly:stencil-combine-at-edge - page-stencil Y DOWN head 0. 0.)) + 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 (ly:stencil? foot) + (if (and (ly:stencil? foot) + (not (ly:stencil-empty? foot))) (set! page-stencil (ly:stencil-add page-stencil @@ -169,7 +178,7 @@ create offsets. ;; ;; - density scoring ;; - separate function for word-wrap style breaking? -;; - raggedbottom? raggedlastbottom? +;; - raggedbottom? raggedlastbottom? (define-public (ly:optimal-page-breaks lines paper-book) @@ -187,11 +196,11 @@ of lines. " (if (procedure? p) (p paper scopes page-number last?) 10000))) - + (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)) @@ -207,8 +216,8 @@ is what have collected so far, and has ascending page numbers." (force-equalization-factor 0.3) (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)) @@ -279,7 +288,7 @@ is what have collected so far, and has ascending page numbers." (distance (max (- (+ (interval-end next-system-ext) fixed-dist) (interval-start this-system-ext) - ) 0)) + ) 0)) (entry (list idx (1+ idx) distance))) entry))) (rods (map calc-rod (iota (1- no-systems)))) @@ -293,9 +302,9 @@ is what have collected so far, and has ascending page numbers." (force (car result)) (positions (map (lambda (y) - (+ y topskip)) + (+ y topskip)) (cdr result)))) - + (if #f ;; debug. (begin (display (list "\n# systems: " no-systems @@ -310,9 +319,9 @@ is what have collected so far, and has ascending page numbers." "\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 CURRENT-LINES. DONE-LINES.reversed ++ CURRENT-LINES is a consecutive @@ -320,14 +329,14 @@ ascending range of lines, and BEST-PATHS contains the optimal breaks corresponding to DONE-LINES. CURRENT-BEST is the best result sofar, or #f." - + (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? + (ragged? (or ragged-all? (and ragged-last? last?))) (page-height (page-height this-page-num last?)) @@ -367,7 +376,7 @@ CURRENT-BEST is the best result sofar, or #f." #:configuration positions #:penalty total-penalty) current-best))) - + (if #f ;; debug (display (list @@ -385,7 +394,7 @@ CURRENT-BEST is the best result sofar, or #f." (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 satisfied-constraints) @@ -413,8 +422,29 @@ DONE." (define (line-number node) (ly:paper-system-number (car (node-lines node)))) + (ly:message (_ "Calculating page breaks...")) + (let* ((best-break-node (walk-lines '() '() lines)) - (break-nodes (get-path best-break-node '()))) + (break-nodes (get-path best-break-node '())) + (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 @@ -423,14 +453,7 @@ DONE." "\nsystems " (map node-lines break-nodes) "\npenalties " (map node-penalty break-nodes) "\nconfigs " (map node-configuration break-nodes)))) - - ;; create stencils. - (map (lambda (node) - ((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))) - break-nodes))) + + (let ((stencils (map node->page-stencil break-nodes))) + (ly:progress "\n") + stencils)))