X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpaper-system.scm;h=9e9f9ab7d4ca85357f1b759de1745cc5ae75a384;hb=766e64a52830a300841dae05235f5aa96fd330fa;hp=2f22865b4830fed7e6a7b2c06611d27da78f3ad6;hpb=e6e2c951c43f212538badec0c4e053d31feea3c8;p=lilypond.git diff --git a/scm/paper-system.scm b/scm/paper-system.scm index 2f22865b48..9e9f9ab7d4 100644 --- a/scm/paper-system.scm +++ b/scm/paper-system.scm @@ -1,10 +1,19 @@ -;; -;; paper-system.scm -- implement paper-system objects. -;; -;; 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 paper-system)) @@ -17,6 +26,14 @@ (define-public (paper-system-stencil system) (ly:prob-property system 'stencil)) +(define-public (paper-system-layout system) + (let* + ((g (paper-system-system-grob system))) + + (if (ly:grob? g) + (ly:grob-layout g) + #f))) + (define-public (paper-system-system-grob paper-system) (ly:prob-property paper-system 'system-grob)) @@ -24,7 +41,7 @@ (ly:stencil-extent (paper-system-stencil system) axis)) (define-public (paper-system-staff-extents ps) - (ly:prob-property ps 'refpoint-Y-extent '(0 . 0))) + (ly:prob-property ps 'staff-refpoint-extent '(0 . 0))) (define-public (paper-system-annotate-last system layout) (let* @@ -48,86 +65,41 @@ (set! (ly:prob-property system 'stencil) stencil) )) - + +; TODO: annotate the spacing for every spaceable staff within the system. (define-public (paper-system-annotate system next-system layout) "Add arrows and texts to indicate which lengths are set." (let* ((annotations (list)) - (annotate-extent-and-space - (lambda (extent-accessor next-space - extent-name next-space-name after-space-name) - (let* ((extent-annotations (list)) - (this-extent (extent-accessor system)) - (next-extent (and next-system (extent-accessor next-system))) - (push-annotation (lambda (stil) - (set! extent-annotations - (cons stil extent-annotations)))) - (color (if (paper-system-title? system) darkblue blue)) - (space-color (if (paper-system-title? system) darkred red))) - (if (and (number-pair? this-extent) - (not (= (interval-start this-extent) - (interval-end this-extent)))) - (push-annotation (annotate-y-interval - layout extent-name this-extent #f - #:color color))) - (if next-system - (push-annotation (annotate-y-interval - layout next-space-name - (interval-translate (cons (- next-space) 0) - (if (number-pair? this-extent) - (interval-start this-extent) - 0)) - #t - #:color color))) - (if (and next-system - (number-pair? this-extent) - (number-pair? next-extent)) - (let ((space-after - (- (+ (ly:prob-property next-system 'Y-offset) - (interval-start this-extent)) - (ly:prob-property system 'Y-offset) - (interval-end next-extent) - next-space))) - (if (> space-after 0.01) - (push-annotation (annotate-y-interval - layout - after-space-name - (interval-translate - (cons (- space-after) 0) - (- (interval-start this-extent) - next-space)) - #t - #:color space-color))))) - (if (not (null? extent-annotations)) - (set! annotations - (stack-stencils X RIGHT 0.5 - (list annotations - (ly:make-stencil '() (cons 0 1) (cons 0 0)) - (apply ly:stencil-add - extent-annotations))))))))) - (let ((next-space (ly:prob-property - system 'next-space - (cond ((and next-system - (paper-system-title? system) - (paper-system-title? next-system)) - (ly:output-def-lookup layout 'between-title-space)) - ((paper-system-title? system) - (ly:output-def-lookup layout 'after-title-space)) - ((and next-system - (paper-system-title? next-system)) - (ly:output-def-lookup layout 'before-title-space)) - (else - (ly:output-def-lookup layout 'between-system-space))))) - (next-padding (ly:prob-property - system 'next-padding - (ly:output-def-lookup layout 'between-system-padding)))) - (annotate-extent-and-space (lambda (sys) - (paper-system-extent sys Y)) - next-padding - "Y-extent" "next-padding" "space after next-padding") - (annotate-extent-and-space paper-system-staff-extents - (+ next-space next-padding) - "refpoint-Y-extent" "next-space+padding" - "space after next-space+padding")) + (grob (ly:prob-property system 'system-grob)) + (estimate-extent (if (ly:grob? grob) + (annotate-y-interval layout + "extent-estimate" + (ly:grob-property grob 'pure-Y-extent) + #f) + #f))) + (let* ((spacing-spec (cond ((and next-system + (paper-system-title? system) + (paper-system-title? next-system)) + (ly:output-def-lookup layout 'markup-markup-spacing)) + ((paper-system-title? system) + (ly:output-def-lookup layout 'markup-system-spacing)) + ((and next-system + (paper-system-title? next-system)) + (ly:output-def-lookup layout 'score-markup-spacing)) + ((not next-system) + (ly:output-def-lookup layout 'last-bottom-spacing)) + (else + (ly:output-def-lookup layout 'system-system-spacing)))) + (last-staff-Y (car (paper-system-staff-extents system)))) + + (set! annotations + (annotate-spacing-spec layout spacing-spec last-staff-Y (car (paper-system-extent system Y))))) + (if estimate-extent + (set! annotations + (stack-stencils X RIGHT 0.5 + (list annotations + estimate-extent)))) + (if (not (null? annotations)) (set! (ly:prob-property system 'stencil) (ly:stencil-add @@ -136,4 +108,4 @@ (ly:stencil-expr annotations) (ly:stencil-extent empty-stencil X) (ly:stencil-extent empty-stencil Y))))) - (ly:prob-property system 'stencil))) \ No newline at end of file + (ly:prob-property system 'stencil)))