X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpage.scm;h=20e58b61e21c4bf0bcdac8a61318a15cebace630;hb=HEAD;hp=0a30acef4dd0471f837cb2d5acf2c9bb6fcffe71;hpb=fb0b572f923f29e02bc9909a4cf5cc674e5315d5;p=lilypond.git diff --git a/scm/page.scm b/scm/page.scm index 0a30acef4d..20e58b61e2 100644 --- a/scm/page.scm +++ b/scm/page.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2006--2011 Han-Wen Nienhuys +;;;; Copyright (C) 2006--2015 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -18,25 +18,25 @@ (define-module (scm page) #:export (make-page - page-property - page-set-property! - page-prev - page-printable-height - layout->page-init - page-force - page-penalty - page-configuration - page-lines - page-page-number - page-system-numbers - page-stencil - page-free-height - page? - )) + page-property + page-set-property! + page-prev + page-printable-height + layout->page-init + page-force + page-penalty + page-configuration + page-lines + page-page-number + page-system-numbers + page-stencil + page-free-height + page? + )) (use-modules (lily) - (scm paper-system) - (srfi srfi-1)) + (scm paper-system) + (srfi srfi-1)) (define (annotate? layout) @@ -48,9 +48,9 @@ (define (make-page paper-book . args) (let* ((p (apply ly:make-prob (append - (list 'page (layout->page-init (ly:paper-book-paper paper-book)) - 'paper-book paper-book) - args)))) + (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)) (page-set-property! p 'foot-stencil (page-footer p)) @@ -82,63 +82,60 @@ (define (page-translate-systems page) (for-each - (lambda (sys-off) - (let* - ((sys (car sys-off)) - (off (cadr sys-off))) + (lambda (sys off) + (if (not (number? (ly:prob-property sys 'Y-offset))) + (ly:prob-set-property! sys 'Y-offset 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)))) + (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-markup-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))) + (sym (if (paper-system-title? first-system) + 'top-markup-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))) + (ly:stencil-add stencil + (ly:stencil-translate-axis + (annotate-spacing-spec layout + (symbol->string sym) + 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)) - (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)))))) + (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) + (cons (- paper-height) 0) + #t) 1 X)) (add-stencil (ly:stencil-translate-axis (annotate-y-interval layout "top-margin" - (cons (- top-margin) 0) - #t) + (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) + (cons (- paper-height) (- bottom-margin paper-height)) + #t) 2 X)) stencil)) @@ -147,16 +144,16 @@ ((paper-book (page-property page 'paper-book)) (layout (ly:paper-book-paper paper-book)) (arrow (annotate-y-interval layout - "space left" - (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))) + "space left" + (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))) (set! arrow (ly:stencil-translate-axis arrow 8 X)) @@ -172,13 +169,13 @@ (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)) + '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))) + (header-proc layout scopes number is-last-bookpart is-bookpart-last-page) + #f))) (define (page-header page) @@ -195,7 +192,7 @@ (left-margin (ly:output-def-lookup layout 'left-margin)) (right-margin (ly:output-def-lookup layout 'right-margin)) (bottom-edge (- paper-height - (ly:output-def-lookup layout 'bottom-margin)) ) + (ly:output-def-lookup layout 'bottom-margin)) ) (top-margin (ly:output-def-lookup layout 'top-margin)) ) @@ -225,114 +222,116 @@ (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) - system-separator-markup) - #f)) + (interpret-markup layout + (layout-extract-page-properties layout) + system-separator-markup) + #f)) - (page-stencil (ly:make-stencil '())) + (page-stencil empty-stencil) (last-system #f) (last-y 0.0) (add-to-page (lambda (stencil x y) - (set! page-stencil - (ly:stencil-add page-stencil - (ly:stencil-translate stencil - (cons - (+ system-xoffset x) - (- 0 y (prop 'top-margin))) - - ))))) + (set! page-stencil + (ly:stencil-add page-stencil + (ly:stencil-translate stencil + (cons + (+ system-xoffset x) + (- 0 y (prop 'top-margin))) + + ))))) (add-system - (lambda (system) - (let* ((stencil (paper-system-stencil system)) - (y (ly:prob-property system 'Y-offset 0)) - (is-title (paper-system-title? - 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 - (cdr (paper-system-staff-extents system)))))) - (set! last-system system) - (set! last-y y)))) + (lambda (system) + (let* ((stencil (paper-system-stencil system)) + (extra-offset (ly:prob-property system 'extra-offset '(0 . 0))) + (x (+ (ly:prob-property system 'X-offset 0.0) + (car extra-offset))) + (y (+ (ly:prob-property system 'Y-offset 0.0) + (cdr extra-offset))) + (is-title (paper-system-title? + system))) + (add-to-page stencil x 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 + (cdr (paper-system-staff-extents system)))))) + (set! last-system system) + (set! last-y y)))) (head (prop 'head-stencil)) (foot (prop 'foot-stencil)) ) (if (and - (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)))) + (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)) + (annotate? layout) + (pair? lines)) - (begin - (set! page-stencil (annotate-top-space (car lines) layout head page-stencil)) + (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))) + (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))) - (map add-system lines) + (for-each add-system lines) (ly:prob-set-property! page 'bottom-system-edge - (car (ly:stencil-extent page-stencil Y))) + (car (ly:stencil-extent page-stencil Y))) (ly:prob-set-property! page 'space-left - (+ (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))) + (+ (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 - (ly:stencil-add page-stencil - (annotate-space-left page)))) + (set! page-stencil + (ly:stencil-add page-stencil + (annotate-space-left page)))) (if (and (ly:stencil? foot) - (not (ly:stencil-empty? foot))) - (set! page-stencil - (ly:stencil-add - page-stencil - (ly:stencil-translate - foot - (cons 0 - (+ (- (prop 'bottom-edge)) - (- (car (ly:stencil-extent foot Y))))))))) + (not (ly:stencil-empty? foot))) + (set! page-stencil + (ly:stencil-add + page-stencil + (ly:stencil-translate + foot + (cons 0 + (+ (- (prop 'bottom-edge)) + (- (car (ly:stencil-extent foot Y))))))))) (if (ly:output-def-lookup layout 'two-sided #f) - (set! page-stencil - (ly:stencil-translate page-stencil - (cons (prop (if (even? number) - 'left-margin - 'right-margin)) - 0))) - (set! page-stencil - (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))) + (set! page-stencil + (ly:stencil-translate page-stencil + (cons (prop (if (even? number) + 'left-margin + 'right-margin)) + 0))) + (set! page-stencil + (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))) ;; annotation. (if (annotate? layout) - (set! page-stencil (annotate-page layout page-stencil))) + (set! page-stencil (annotate-page layout page-stencil))) page-stencil)) @@ -352,18 +351,18 @@ ((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))) + (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)) (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)))) + (- 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)) @@ -373,4 +372,3 @@ (page-set-property! page 'printable-height (calc-printable-height page))) (page-property page 'printable-height)) -