X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scm%2Fpage.scm;h=ca4e0d8659ddeba0b1f2bcb26cb05aab2f9303bd;hb=7df6ed01116dac2a8ea1babfb3f7184859ebf6c7;hp=258589ae53617e4576437a97e3477f504681c34e;hpb=a732d02103df02d413b35dae436c38db538e9fd1;p=lilypond.git diff --git a/scm/page.scm b/scm/page.scm index 258589ae53..ca4e0d8659 100644 --- a/scm/page.scm +++ b/scm/page.scm @@ -37,10 +37,11 @@ (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)) @@ -84,6 +85,27 @@ (zip (page-property page 'lines) (page-property page 'configuration)))) +(define (annotate-top-space first-system layout header-stencil stencil) + (let* ((top-margin (ly:output-def-lookup layout 'top-margin)) + (sym (if (paper-system-title? first-system) + 'top-title-spacing + 'top-system-spacing)) + (spacing-spec (ly:output-def-lookup layout sym)) + (X-offset (ly:prob-property first-system 'X-offset 5)) + (header-extent (ly:stencil-extent header-stencil Y))) + + (set! stencil + (ly:stencil-add stencil + (ly:stencil-translate-axis + (annotate-spacing-spec layout + spacing-spec + (- top-margin) + (car header-extent) + #:base-color red) + X-offset X))) + stencil)) + + (define (annotate-page layout stencil) (let ((top-margin (ly:output-def-lookup layout 'top-margin)) (paper-height (ly:output-def-lookup layout 'paper-height)) @@ -114,8 +136,8 @@ (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 (- 0.0 @@ -132,83 +154,24 @@ arrow)) - - - -(define (page-headfoot layout scopes number - sym separation-symbol dir last?) - - "Create a stencil including separating space." - - (let* ((header-proc (ly:output-def-lookup layout sym)) - (sep (ly:output-def-lookup layout separation-symbol)) - (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0))) - (head-stencil - (if (procedure? header-proc) - (header-proc layout scopes number last?) - #f)) - ) - - (if (and (number? sep) - (ly:stencil? head-stencil) - (not (ly:stencil-empty? head-stencil))) - - (begin - (set! head-stencil - (ly:stencil-combine-at-edge - stencil Y dir head-stencil - sep 0.0)) - - - ;; add arrow markers - (if (or (annotate? layout) - (ly:output-def-lookup layout 'annotate-headers #f)) - (set! head-stencil - (ly:stencil-add - (ly:stencil-translate-axis - (annotate-y-interval layout - (symbol->string separation-symbol) - (cons (min 0 (* dir sep)) - (max 0 (* dir sep))) - #t) - (/ (ly:output-def-lookup layout 'line-width) 2) - X) - (if (= dir UP) - (ly:stencil-translate-axis - (annotate-y-interval layout - "page-top-space" - (cons - (- (min 0 (* dir sep)) - (ly:output-def-lookup layout 'page-top-space)) - (min 0 (* dir sep))) - #t) - (+ 7 (interval-center (ly:stencil-extent head-stencil X))) X) - empty-stencil - ) - head-stencil - )) - ))) - - head-stencil)) (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)) - ) - - (page-headfoot layout scopes number - (if (= dir UP) - 'make-header - 'make-footer) - (if (= dir UP) - 'head-separation - 'foot-separation) - dir last?))) + (is-last-bookpart (page-property page 'is-last-bookpart)) + (is-bookpart-last-page (page-property page 'is-bookpart-last-page)) + (sym (if (= dir UP) + 'make-header + 'make-footer)) + (header-proc (ly:output-def-lookup layout sym))) + + (if (procedure? header-proc) + (header-proc layout scopes number is-last-bookpart is-bookpart-last-page) + #f))) + (define (page-header page) (page-header-or-footer page UP)) @@ -221,8 +184,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,42 +202,29 @@ ))) (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) system-separator-markup) #f)) - (head-height (if (ly:stencil? (prop 'head-stencil)) - (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) @@ -285,8 +234,8 @@ create offsets. (ly:stencil-translate stencil (cons (+ system-xoffset x) - (- 0 head-height y (prop 'top-margin))) - + (- 0 y (prop 'top-margin))) + ))))) (add-system (lambda (system) @@ -315,28 +264,30 @@ create offsets. ) (if (and - (or (annotate? layout) - (ly:output-def-lookup layout 'annotate-systems #f)) + (ly:stencil? head) + (not (ly:stencil-empty? head))) + (begin + ;; Ensure that the top of the header just touches the top margin. + (set! head (ly:stencil-translate-axis head + (- 0 (cdr (ly:stencil-extent head Y)) (prop 'top-margin)) Y)) + (set! page-stencil (ly:stencil-add page-stencil head)))) + + (if (and + (annotate? layout) (pair? lines)) (begin + (set! page-stencil (annotate-top-space (car lines) layout head page-stencil)) + (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.)) (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 @@ -367,8 +318,7 @@ create offsets. (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0))) ;; annotation. - (if (or (annotate? layout) - (ly:output-def-lookup layout 'annotate-page #f)) + (if (annotate? layout) (set! page-stencil (annotate-page layout page-stencil))) page-stencil)) @@ -386,8 +336,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)) + ((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)))