X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpage.scm;fp=scm%2Fpage.scm;h=f65c9559d3ca7510e695638c0c0ae3c949245bd9;hb=e90f0536f9be39ada0bef0aeb0d275dec3b2fb5b;hp=a4862198010c206a36b72febae29b8d3ee3aeefa;hpb=a8c9e8a7ca320ab0df5fd32e717fd62cd7635ce6;p=lilypond.git diff --git a/scm/page.scm b/scm/page.scm index a486219801..f65c9559d3 100644 --- a/scm/page.scm +++ b/scm/page.scm @@ -1,10 +1,19 @@ -;; -;; page.scm -- implement Page stuff. -;; -;; source file of the GNU LilyPond music typesetter -;; -;; (c) 2006 Han-Wen Nienhuys -;; +;;;; This file is part of LilyPond, the GNU music typesetter. +;;;; +;;;; Copyright (C) 2006--2011 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 +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . (define-module (scm page) @@ -14,8 +23,7 @@ page-prev page-printable-height layout->page-init - page-lines - page-force + page-force page-penalty page-configuration page-lines @@ -23,7 +31,7 @@ page-system-numbers page-stencil page-free-height - page? + page? )) (use-modules (lily) @@ -46,9 +54,9 @@ (page-set-property! p 'head-stencil (page-header p)) (page-set-property! p 'foot-stencil (page-footer p)) - + p)) - + (define page-property ly:prob-property) (define page-set-property! ly:prob-set-property!) (define (page-property? page sym) @@ -56,7 +64,7 @@ (define (page? x) (ly:prob-type? x 'page)) -;; define accessors. +;; define accessors. (for-each (lambda (j) (module-define! @@ -64,7 +72,7 @@ (string->symbol (format "page-~a" j)) (lambda (pg) (page-property pg j)))) - + '(page-number prev lines force penalty lines)) (define (page-system-numbers page) @@ -81,10 +89,31 @@ (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-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))) + + (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)) @@ -94,19 +123,19 @@ (ly:stencil-add stencil (ly:stencil-translate-axis y 6 X)))))) (add-stencil - (ly:stencil-translate-axis + (ly:stencil-translate-axis (annotate-y-interval layout "paper-height" (cons (- paper-height) 0) #t) 1 X)) (add-stencil - (ly:stencil-translate-axis + (ly:stencil-translate-axis (annotate-y-interval layout "top-margin" (cons (- top-margin) 0) #t) 2 X)) (add-stencil - (ly:stencil-translate-axis + (ly:stencil-translate-axis (annotate-y-interval layout "bottom-margin" (cons (- paper-height) (- bottom-margin paper-height)) #t) @@ -133,81 +162,24 @@ arrow)) - - - -(define (page-headfoot layout scopes number sym separation-symbol dir - is-last-bookpart is-bookpart-last-page) - - "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 is-last-bookpart is-bookpart-last-page) - #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)) - - - ;; 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* + (let* ((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)) (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) - 'head-separation - 'foot-separation) - dir is-last-bookpart is-bookpart-last-page))) + (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)) @@ -220,26 +192,24 @@ (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 #f)) - (left-margin (if lmargin - lmargin - (/ (- paper-width - (ly:output-def-lookup layout 'line-width)) 2))) + (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)) ) (top-margin (ly:output-def-lookup layout 'top-margin)) ) - + `((paper-height . ,paper-height) (paper-width . ,paper-width) (left-margin . ,left-margin) + (right-margin . ,right-margin) (top-margin . ,top-margin) (bottom-edge . ,bottom-edge) ))) (define (make-page-stencil page) "Construct a stencil representing the page from PAGE." - + (page-translate-systems page) (let* @@ -251,7 +221,7 @@ (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 'system-separator-markup)) (system-separator-stencil (if (markup? system-separator-markup) @@ -259,10 +229,6 @@ (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 '())) @@ -274,13 +240,13 @@ (ly:stencil-translate stencil (cons (+ system-xoffset x) - (- 0 head-height y (prop 'top-margin))) - + (- 0 y (prop 'top-margin))) + ))))) (add-system (lambda (system) (let* ((stencil (paper-system-stencil system)) - (y (ly:prob-property system 'Y-offset)) + (y (ly:prob-property system 'Y-offset 0)) (is-title (paper-system-title? system))) (add-to-page stencil @@ -304,25 +270,27 @@ ) (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))) - (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) @@ -340,7 +308,7 @@ (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 @@ -352,24 +320,29 @@ (+ (- (prop 'bottom-edge)) (- (car (ly:stencil-extent foot Y))))))))) - (set! page-stencil - (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0))) + (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)))) ;; 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)) - + (define-public (page-stencil page) (if (not (ly:stencil? (page-property page 'stencil))) ;; todo: make tweakable. ;; via property + callbacks. - + (page-set-property! page 'stencil (make-page-stencil page))) (page-property page 'stencil)) @@ -379,9 +352,9 @@ ((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 @@ -391,13 +364,13 @@ (if (ly:stencil? foot) (interval-length (ly:stencil-extent foot Y)) 0)))) - + ;; (display (list "\n available" available head foot)) available)) (define (page-printable-height page) (if (not (number? (page-property page 'printable-height))) (page-set-property! page 'printable-height (calc-printable-height page))) - + (page-property page 'printable-height))