X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpage.scm;h=a4862198010c206a36b72febae29b8d3ee3aeefa;hb=2a4d103f3a5977cc4f132d534132dc74dd4071d9;hp=9d299e8ca7b83add964ec36a6198a9a0801f1f84;hpb=bbcb58184883768ca35d64451d7f693d2db11bb7;p=lilypond.git diff --git a/scm/page.scm b/scm/page.scm index 9d299e8ca7..a486219801 100644 --- a/scm/page.scm +++ b/scm/page.scm @@ -32,15 +32,16 @@ (define (annotate? layout) - (eq? #t (ly:output-def-lookup layout 'annotatespacing))) + (eq? #t (ly:output-def-lookup layout 'annotate-spacing))) (define page-module (current-module)) -(define (make-page init . args) +(define (make-page paper-book . args) (let* ((p (apply ly:make-prob (append - (list 'page init) + (list 'page (layout->page-init (ly:paper-book-paper paper-book)) + 'paper-book paper-book) args)))) (page-set-property! p 'head-stencil (page-header p)) @@ -85,46 +86,46 @@ (page-property page 'configuration)))) (define (annotate-page layout stencil) - (let* - ((top-margin (ly:output-def-lookup layout 'top-margin)) - (paper-height (ly:output-def-lookup layout 'paper-height)) - (bottom-margin (ly:output-def-lookup layout 'bottom-margin)) - (add-stencil (lambda (y) - (set! stencil - (ly:stencil-add stencil y)) - ))) - + (let ((top-margin (ly:output-def-lookup layout 'top-margin)) + (paper-height (ly:output-def-lookup layout 'paper-height)) + (bottom-margin (ly:output-def-lookup layout 'bottom-margin)) + (add-stencil (lambda (y) + (set! stencil + (ly:stencil-add stencil + (ly:stencil-translate-axis y 6 X)))))) (add-stencil (ly:stencil-translate-axis (annotate-y-interval layout "paper-height" (cons (- paper-height) 0) #t) 1 X)) - - (add-stencil (ly:stencil-translate-axis (annotate-y-interval layout "top-margin" (cons (- top-margin) 0) #t) 2 X)) - (add-stencil (ly:stencil-translate-axis (annotate-y-interval layout "bottom-margin" (cons (- paper-height) (- bottom-margin paper-height)) #t) 2 X)) - stencil)) (define (annotate-space-left page) (let* - ((p-book (page-property page 'paper-book)) - (layout (ly:paper-book-paper p-book)) + ((paper-book (page-property page 'paper-book)) + (layout (ly:paper-book-paper paper-book)) (arrow (annotate-y-interval layout "space left" - (cons (- (page-property page 'bottom-edge)) + (cons (- 0.0 + (page-property page 'bottom-edge) + (let ((foot (page-property page 'foot-stencil))) + (if (and (ly:stencil? foot) + (not (ly:stencil-empty? foot))) + (car (ly:stencil-extent foot Y)) + 0.0))) (page-property page 'bottom-system-edge)) #t))) @@ -135,8 +136,8 @@ -(define (page-headfoot layout scopes number - sym separation-symbol dir last?) +(define (page-headfoot layout scopes number sym separation-symbol dir + is-last-bookpart is-bookpart-last-page) "Create a stencil including separating space." @@ -145,9 +146,8 @@ (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0))) (head-stencil (if (procedure? header-proc) - (header-proc layout scopes number last?) - #f)) - ) + (header-proc layout scopes number is-last-bookpart is-bookpart-last-page) + #f))) (if (and (number? sep) (ly:stencil? head-stencil) @@ -157,12 +157,12 @@ (set! head-stencil (ly:stencil-combine-at-edge stencil Y dir head-stencil - sep 0.0)) + sep)) ;; add arrow markers (if (or (annotate? layout) - (ly:output-def-lookup layout 'annotateheaders #f)) + (ly:output-def-lookup layout 'annotate-headers #f)) (set! head-stencil (ly:stencil-add (ly:stencil-translate-axis @@ -193,22 +193,21 @@ (define (page-header-or-footer page dir) (let* - ((p-book (page-property page 'paper-book)) - (layout (ly:paper-book-paper p-book)) - (scopes (ly:paper-book-scopes p-book)) - (lines (page-lines page)) + ((paper-book (page-property page 'paper-book)) + (layout (ly:paper-book-paper paper-book)) + (scopes (ly:paper-book-scopes paper-book)) (number (page-page-number page)) - (last? (page-property page 'is-last)) - ) + (is-last-bookpart (page-property page 'is-last-bookpart)) + (is-bookpart-last-page (page-property page 'is-bookpart-last-page))) (page-headfoot layout scopes number (if (= dir UP) 'make-header 'make-footer) (if (= dir UP) - 'heap-separation + 'head-separation 'foot-separation) - dir last?))) + dir is-last-bookpart is-bookpart-last-page))) (define (page-header page) (page-header-or-footer page UP)) @@ -221,8 +220,7 @@ (let* ((paper-height (ly:output-def-lookup layout 'paper-height)) (paper-width (ly:output-def-lookup layout 'paper-width)) - - (lmargin (ly:output-def-lookup layout 'left-margin)) + (lmargin (ly:output-def-lookup layout 'left-margin #f)) (left-margin (if lmargin lmargin (/ (- paper-width @@ -240,28 +238,22 @@ ))) (define (make-page-stencil page) - "Construct a stencil representing the page from LINES. - - Offsets is a list of increasing numbers. They must be negated to -create offsets. -" - + "Construct a stencil representing the page from PAGE." (page-translate-systems page) (let* - ((p-book (page-property page 'paper-book)) + ((paper-book (page-property page 'paper-book)) (prop (lambda (sym) (page-property page sym))) - (layout (ly:paper-book-paper p-book)) - (scopes (ly:paper-book-scopes p-book)) + (layout (ly:paper-book-paper paper-book)) + (scopes (ly:paper-book-scopes paper-book)) (lines (page-lines page)) (number (page-page-number page)) ;; TODO: naming paper-height/paper-width not analogous to TeX. - (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0)) - (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup)) + (system-separator-markup (ly:output-def-lookup layout 'system-separator-markup)) (system-separator-stencil (if (markup? system-separator-markup) (interpret-markup layout (layout-extract-page-properties layout) @@ -272,10 +264,7 @@ create offsets. (interval-length (ly:stencil-extent (prop 'head-stencil) Y)) 0.0)) - (page-stencil (ly:make-stencil - '() - (cons (prop 'left-margin) (prop 'paper-width)) - (cons (- (prop 'top-margin)) 0))) + (page-stencil (ly:make-stencil '())) (last-system #f) (last-y 0.0) @@ -286,7 +275,7 @@ create offsets. (cons (+ system-xoffset x) (- 0 head-height y (prop 'top-margin))) - + ))))) (add-system (lambda (system) @@ -314,29 +303,38 @@ create offsets. (foot (prop 'foot-stencil)) ) - (if (or (annotate? layout) - (ly:output-def-lookup layout 'annotatesystems #f)) + (if (and + (or (annotate? layout) + (ly:output-def-lookup layout 'annotate-systems #f)) + (pair? lines)) (begin - (for-each (lambda (sys) (paper-system-annotate sys layout)) - lines) + (for-each (lambda (sys next-sys) + (paper-system-annotate sys next-sys layout)) + lines + (append (cdr lines) (list #f))) (paper-system-annotate-last (car (last-pair lines)) layout))) - - (set! page-stencil (ly:stencil-combine-at-edge - 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.)) + (if (and + (ly:stencil? head) + (not (ly:stencil-empty? head))) + + (set! page-stencil (ly:stencil-add page-stencil + (ly:stencil-translate-axis head + (- 0 head-height (prop 'top-margin)) Y)))) + (map add-system lines) + (ly:prob-set-property! page 'bottom-system-edge (car (ly:stencil-extent page-stencil Y))) (ly:prob-set-property! page 'space-left - (car (ly:stencil-extent page-stencil Y))) + (+ (prop 'bottom-edge) + (prop 'bottom-system-edge) + (if (and (ly:stencil? foot) + (not (ly:stencil-empty? foot))) + (car (ly:stencil-extent foot Y)) + 0.0))) (if (annotate? layout) (set! page-stencil @@ -359,13 +357,14 @@ create offsets. ;; annotation. (if (or (annotate? layout) - (ly:output-def-lookup layout 'annotatepage #f)) + (ly:output-def-lookup layout 'annotate-page #f)) (set! page-stencil (annotate-page layout page-stencil))) + page-stencil)) -(define (page-stencil page) +(define-public (page-stencil page) (if (not (ly:stencil? (page-property page 'stencil))) ;; todo: make tweakable. @@ -377,11 +376,8 @@ create offsets. (define (calc-printable-height page) "Printable area for music and titles; matches default-page-make-stencil." (let* - ((p-book (page-property page 'paper-book)) - (layout (ly:paper-book-paper p-book)) - (scopes (ly:paper-book-scopes p-book)) - (number (page-page-number page)) - (last? (page-property page 'is-last)) + ((paper-book (page-property page 'paper-book)) + (layout (ly:paper-book-paper paper-book)) (h (- (ly:output-def-lookup layout 'paper-height) (ly:output-def-lookup layout 'top-margin) (ly:output-def-lookup layout 'bottom-margin)))