X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpage.scm;h=a4862198010c206a36b72febae29b8d3ee3aeefa;hb=e804710e1fe0070ea072d4e1fbf3e534cf951d09;hp=7eb5cb69ae31a9370433f47d13c6d95171d3f845;hpb=9be810ebcf226f2e5d7445f4e647f13aa0ac29e3;p=lilypond.git diff --git a/scm/page.scm b/scm/page.scm index 7eb5cb69ae..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)) @@ -64,53 +65,67 @@ (lambda (pg) (page-property pg j)))) - '(page-number prev lines force penalty configuration lines)) + '(page-number prev lines force penalty lines)) -(define (page-system-numbers node) +(define (page-system-numbers page) (map (lambda (ps) (ly:prob-property ps 'number)) - (page-lines node))) - -(define (annotate-page stencil layout) - (let* - ((topmargin (ly:output-def-lookup layout 'topmargin)) - (vsize (ly:output-def-lookup layout 'vsize)) - (bottommargin (ly:output-def-lookup layout 'bottommargin)) - (add-stencil (lambda (y) - (set! stencil - (ly:stencil-add stencil y)) - ))) - + (page-lines page))) + +(define (page-translate-systems page) + (for-each + + (lambda (sys-off) + (let* + ((sys (car sys-off)) + (off (cadr sys-off))) + + (if (not (number? (ly:prob-property sys 'Y-offset))) + (ly:prob-set-property! sys 'Y-offset off)))) + + (zip (page-property page 'lines) + (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 + (ly:stencil-translate-axis y 6 X)))))) (add-stencil (ly:stencil-translate-axis - (annotate-y-interval layout "vsize" - (cons (- vsize) 0) + (annotate-y-interval layout "paper-height" + (cons (- paper-height) 0) #t) 1 X)) - - (add-stencil (ly:stencil-translate-axis - (annotate-y-interval layout "topmargin" - (cons (- topmargin) 0) + (annotate-y-interval layout "top-margin" + (cons (- top-margin) 0) #t) 2 X)) - (add-stencil (ly:stencil-translate-axis - (annotate-y-interval layout "bottommargin" - (cons (- vsize) (- bottommargin vsize)) + (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 page)) + ((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))) @@ -121,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." @@ -131,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) @@ -143,11 +157,12 @@ (set! head-stencil (ly:stencil-combine-at-edge stencil Y dir head-stencil - sep 0.0)) + sep)) ;; add arrow markers - (if (annotate? layout) + (if (or (annotate? layout) + (ly:output-def-lookup layout 'annotate-headers #f)) (set! head-stencil (ly:stencil-add (ly:stencil-translate-axis @@ -156,15 +171,15 @@ (cons (min 0 (* dir sep)) (max 0 (* dir sep))) #t) - (/ (ly:output-def-lookup layout 'linewidth) 2) + (/ (ly:output-def-lookup layout 'line-width) 2) X) (if (= dir UP) (ly:stencil-translate-axis (annotate-y-interval layout - "pagetopspace" + "page-top-space" (cons (- (min 0 (* dir sep)) - (ly:output-def-lookup layout 'pagetopspace)) + (ly:output-def-lookup layout 'page-top-space)) (min 0 (* dir sep))) #t) (+ 7 (interval-center (ly:stencil-extent head-stencil X))) X) @@ -178,23 +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)) - (offsets (page-configuration 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) - 'headsep - 'footsep) - dir last?))) + 'head-separation + 'foot-separation) + dir is-last-bookpart is-bookpart-last-page))) (define (page-header page) (page-header-or-footer page UP)) @@ -205,50 +218,42 @@ (define (layout->page-init layout) "Alist of settings for page layout" (let* - ((vsize (ly:output-def-lookup layout 'vsize)) - (hsize (ly:output-def-lookup layout 'hsize)) - - (lmargin (ly:output-def-lookup layout 'leftmargin)) - (leftmargin (if lmargin + ((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 #f)) + (left-margin (if lmargin lmargin - (/ (- hsize - (ly:output-def-lookup layout 'linewidth)) 2))) - - (bottom-edge (- vsize - (ly:output-def-lookup layout 'bottommargin))) - (top-margin (ly:output-def-lookup layout 'topmargin)) + (/ (- paper-width + (ly:output-def-lookup layout 'line-width)) 2))) + (bottom-edge (- paper-height + (ly:output-def-lookup layout 'bottom-margin)) ) + (top-margin (ly:output-def-lookup layout 'top-margin)) ) - `((vsize . ,vsize) - (hsize . ,hsize) - (left-margin . ,leftmargin) + `((paper-height . ,paper-height) + (paper-width . ,paper-width) + (left-margin . ,left-margin) (top-margin . ,top-margin) (bottom-edge . ,bottom-edge) ))) (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)) - (offsets (page-configuration page)) (number (page-page-number page)) - ;; TODO: naming vsize/hsize not analogous to TeX. - + ;; TODO: naming paper-height/paper-width not analogous to TeX. - (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0)) - (system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup)) + (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0)) + (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) @@ -259,36 +264,35 @@ create offsets. (interval-length (ly:stencil-extent (prop 'head-stencil) Y)) 0.0)) - (page-stencil (ly:make-stencil - '() - (cons (prop 'left-margin) (prop 'hsize)) - (cons (- (prop 'top-margin)) 0))) + (page-stencil (ly:make-stencil '())) (last-system #f) (last-y 0.0) - (add-to-page (lambda (stencil y) + (add-to-page (lambda (stencil x y) (set! page-stencil (ly:stencil-add page-stencil (ly:stencil-translate stencil (cons - system-xoffset + (+ system-xoffset x) (- 0 head-height y (prop 'top-margin))) - + ))))) (add-system - (lambda (stencil-position) - (let* ((system (car stencil-position)) - (stencil (paper-system-stencil system)) - (y (cadr stencil-position)) + (lambda (system) + (let* ((stencil (paper-system-stencil system)) + (y (ly:prob-property system 'Y-offset)) (is-title (paper-system-title? - (car stencil-position)))) - (add-to-page stencil y) + system))) + (add-to-page stencil + (ly:prob-property system 'X-offset 0.0) + y) (if (and (ly:stencil? system-separator-stencil) last-system (not (paper-system-title? system)) (not (paper-system-title? last-system))) (add-to-page system-separator-stencil + 0 (average (- last-y (car (paper-system-staff-extents last-system))) (- y @@ -299,27 +303,38 @@ create offsets. (foot (prop 'foot-stencil)) ) - (if (annotate? layout) + (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.)) - (map add-system (zip lines offsets)) + (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 @@ -341,13 +356,15 @@ create offsets. (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0))) ;; annotation. - (if (annotate? layout) + (if (or (annotate? layout) + (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. @@ -359,14 +376,11 @@ 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)) - (h (- (ly:output-def-lookup layout 'vsize) - (ly:output-def-lookup layout 'topmargin) - (ly:output-def-lookup layout 'bottommargin))) + ((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))) (head (page-property page 'head-stencil)) (foot (page-property page 'foot-stencil))