From: Joe Neeman Date: Sat, 4 Jun 2011 18:13:31 +0000 (+0300) Subject: Several fixes for annotate-spacing. X-Git-Tag: release/2.15.15-1~50^2~5 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1bbcb5955cad9c9067b66c88caf0b5e77ebb579a;p=lilypond.git Several fixes for annotate-spacing. - Fixes annotate-spacing to use the new spacing names. - Annotates spacing between staves as well as spacing between systems. - Fixes some collisions between annotations. - Padding (between systems, titles and staves) is properly annotated, with the annotation occuring at the horizontal position where the collision would actually happen. If the padding is the cause of the vertical spacing, it is highlighted in green. --- diff --git a/lily/include/skyline-pair.hh b/lily/include/skyline-pair.hh index f4b5ced9e3..0164f785f6 100644 --- a/lily/include/skyline-pair.hh +++ b/lily/include/skyline-pair.hh @@ -41,6 +41,8 @@ public: bool is_empty () const; void print () const; void print_points () const; + + DECLARE_SCHEME_CALLBACK (skyline, (SCM, SCM)); }; #endif /* SKYLINE_PAIR_HH */ diff --git a/lily/include/skyline.hh b/lily/include/skyline.hh index 2eccdb2ef4..638fd6d3f3 100644 --- a/lily/include/skyline.hh +++ b/lily/include/skyline.hh @@ -76,11 +76,22 @@ public: void raise (Real); void shift (Real); Real distance (Skyline const &, Real horizon_padding = 0) const; + Real touching_point (Skyline const &, Real horizon_padding = 0) const; Real height (Real airplane) const; Real max_height () const; + Real max_height_position () const; void set_minimum_height (Real height); void clear (); bool is_empty () const; + + DECLARE_SCHEME_CALLBACK (get_touching_point, (SCM, SCM, SCM)); + DECLARE_SCHEME_CALLBACK (get_distance, (SCM, SCM, SCM)); + DECLARE_SCHEME_CALLBACK (get_max_height, (SCM)); + DECLARE_SCHEME_CALLBACK (get_max_height_position, (SCM)); + DECLARE_SCHEME_CALLBACK (get_height, (SCM, SCM)); + +protected: + Real internal_distance (Skyline const &, Real horizon_padding, Real *touch_point) const; }; extern bool debug_skylines; diff --git a/lily/include/system.hh b/lily/include/system.hh index ee44d2afe6..4a3c3c1b48 100644 --- a/lily/include/system.hh +++ b/lily/include/system.hh @@ -61,6 +61,9 @@ public: DECLARE_SCHEME_CALLBACK (calc_pure_relevant_grobs, (SCM)); DECLARE_SCHEME_CALLBACK (height, (SCM)); DECLARE_SCHEME_CALLBACK (calc_pure_height, (SCM, SCM, SCM)); + DECLARE_SCHEME_CALLBACK (get_staves, (SCM)); + DECLARE_SCHEME_CALLBACK (get_spaceable_staves, (SCM)); + DECLARE_SCHEME_CALLBACK (get_nonspaceable_staves, (SCM)); System (SCM); System (System const &); diff --git a/lily/page-layout-problem-scheme.cc b/lily/page-layout-problem-scheme.cc new file mode 100644 index 0000000000..e4c62d3d29 --- /dev/null +++ b/lily/page-layout-problem-scheme.cc @@ -0,0 +1,36 @@ +/* + This file is part of LilyPond, the GNU music typesetter. + + Copyright (C) 2011 Joe Neeman + + 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 . +*/ + +#include "lily-guile.hh" +#include "grob.hh" +#include "page-layout-problem.hh" + +LY_DEFINE (ly_get_spacing_spec, "ly:get-spacing-spec", 2, 0, 0, + (SCM from_scm, SCM to_scm), + "Return the spacing spec going between the two given grobs," + " @var{from_scm} and @var{to_scm}.") +{ + LY_ASSERT_SMOB (Grob, from_scm, 1); + LY_ASSERT_SMOB (Grob, to_scm, 2); + + Grob *from = unsmob_grob (from_scm); + Grob *to = unsmob_grob (to_scm); + + return Page_layout_problem::get_spacing_spec (from, to, false, 0, 0); +} diff --git a/lily/skyline-pair.cc b/lily/skyline-pair.cc index 2a3b26ff9e..65510ba47b 100644 --- a/lily/skyline-pair.cc +++ b/lily/skyline-pair.cc @@ -20,6 +20,7 @@ #include "skyline-pair.hh" +#include "international.hh" #include "ly-smobs.icc" Skyline_pair::Skyline_pair () @@ -117,3 +118,19 @@ Skyline_pair::print_smob (SCM s, SCM port, scm_print_state *) scm_puts ("#", port); return 1; } + +MAKE_SCHEME_CALLBACK (Skyline_pair, skyline, 2); +SCM +Skyline_pair::skyline (SCM smob, SCM dir_scm) +{ + Skyline_pair *sp = Skyline_pair::unsmob (smob); + Direction dir = robust_scm2dir (dir_scm, UP); + + if (dir == CENTER) + { + warning (_f ("direction must not be CENTER in ly:skyline-pair::skyline")); + dir = UP; + } + + return (*sp)[dir].smobbed_copy (); +} diff --git a/lily/skyline.cc b/lily/skyline.cc index 8f62710b09..d65e48b573 100644 --- a/lily/skyline.cc +++ b/lily/skyline.cc @@ -509,6 +509,21 @@ Skyline::shift (Real s) Real Skyline::distance (Skyline const &other, Real horizon_padding) const +{ + Real dummy; + return internal_distance (other, horizon_padding, &dummy); +} + +Real +Skyline::touching_point (Skyline const &other, Real horizon_padding) const +{ + Real touch; + internal_distance (other, horizon_padding, &touch); + return touch; +} + +Real +Skyline::internal_distance (Skyline const &other, Real horizon_padding, Real *touch_point) const { assert (sky_ == -other.sky_); @@ -534,12 +549,19 @@ Skyline::distance (Skyline const &other, Real horizon_padding) const Real dist = -infinity_f; Real start = -infinity_f; + Real touch = -infinity_f; while (i != padded_this->buildings_.end () && j != padded_other->buildings_.end ()) { Real end = min (i->end_, j->end_); Real start_dist = i->height (start) + j->height (start); Real end_dist = i->height (end) + j->height (end); dist = max (dist, max (start_dist, end_dist)); + + if (end_dist == dist) + touch = end; + else if (start_dist == dist) + touch = start; + if (i->end_ <= j->end_) i++; else @@ -553,6 +575,7 @@ Skyline::distance (Skyline const &other, Real horizon_padding) const delete padded_other; } + *touch_point = touch; return dist; } @@ -580,6 +603,14 @@ Skyline::max_height () const return sky_ * distance (s); } +Real +Skyline::max_height_position () const +{ + Skyline s (-sky_); + s.set_minimum_height (0); + return touching_point (s); +} + void Skyline::set_minimum_height (Real h) { @@ -646,3 +677,61 @@ Skyline::print_smob (SCM s, SCM port, scm_print_state *) return 1; } + +MAKE_SCHEME_CALLBACK_WITH_OPTARGS (Skyline, get_touching_point, 3, 1, "") +SCM +Skyline::get_touching_point (SCM skyline_scm, SCM other_skyline_scm, SCM horizon_padding_scm) +{ + LY_ASSERT_SMOB (Skyline, other_skyline_scm, 1); + + Real horizon_padding = 0; + if (horizon_padding_scm != SCM_UNDEFINED) + { + LY_ASSERT_TYPE (scm_is_number, horizon_padding_scm, 3); + horizon_padding = scm_to_double (horizon_padding_scm); + } + + Skyline *skyline = Skyline::unsmob (skyline_scm); + Skyline *other_skyline = Skyline::unsmob (other_skyline_scm); + return scm_from_double (skyline->touching_point (*other_skyline, horizon_padding)); +} + +MAKE_SCHEME_CALLBACK_WITH_OPTARGS (Skyline, get_distance, 3, 1, "") +SCM +Skyline::get_distance (SCM skyline_scm, SCM other_skyline_scm, SCM horizon_padding_scm) +{ + LY_ASSERT_SMOB (Skyline, other_skyline_scm, 1); + + Real horizon_padding = 0; + if (horizon_padding_scm != SCM_UNDEFINED) + { + LY_ASSERT_TYPE (scm_is_number, horizon_padding_scm, 3); + horizon_padding = scm_to_double (horizon_padding_scm); + } + + Skyline *skyline = Skyline::unsmob (skyline_scm); + Skyline *other_skyline = Skyline::unsmob (other_skyline_scm); + return scm_from_double (skyline->distance (*other_skyline, horizon_padding)); +} + +MAKE_SCHEME_CALLBACK (Skyline, get_max_height, 1) +SCM +Skyline::get_max_height (SCM skyline_scm) +{ + return scm_from_double (Skyline::unsmob (skyline_scm)->max_height ()); +} + +MAKE_SCHEME_CALLBACK (Skyline, get_max_height_position, 1) +SCM +Skyline::get_max_height_position (SCM skyline_scm) +{ + return scm_from_double (Skyline::unsmob (skyline_scm)->max_height_position ()); +} + +MAKE_SCHEME_CALLBACK (Skyline, get_height, 2) +SCM +Skyline::get_height (SCM skyline_scm, SCM x_scm) +{ + Real x = robust_scm2double (x_scm, 0.0); + return scm_from_double (Skyline::unsmob (skyline_scm)->height (x)); +} diff --git a/lily/system.cc b/lily/system.cc index c20f244890..f4a37cd24d 100644 --- a/lily/system.cc +++ b/lily/system.cc @@ -537,6 +537,9 @@ System::get_paper_system () pl->set_property ("page-break-penalty", right_bound->get_property ("page-break-penalty")); pl->set_property ("page-turn-penalty", right_bound->get_property ("page-turn-penalty")); + if (right_bound->original () == dynamic_cast (original ())->get_bound (RIGHT)) + pl->set_property ("last-in-score", SCM_BOOL_T); + Interval staff_refpoints; if (Grob *align = get_vertical_alignment ()) { @@ -837,6 +840,63 @@ System::get_maybe_pure_bound (Direction d, bool pure, int start, int end) return pure ? get_pure_bound (d, start, end) : get_bound (d); } +enum { + SPACEABLE_STAVES, + NONSPACEABLE_STAVES, + ALL_STAVES +}; + +static SCM +get_maybe_spaceable_staves (SCM smob, int filter) +{ + System *me = dynamic_cast (unsmob_grob (smob)); + Grob *align = me->get_vertical_alignment (); + SCM ret = SCM_EOL; + + if (align) + { + SCM *tail = &ret; + extract_grob_set (align, "elements", staves); + + for (vsize i = 0; i < staves.size (); ++i) + { + bool spaceable = Page_layout_problem::is_spaceable (staves[i]); + if (staves[i]->is_live () && + ((filter == ALL_STAVES) + || (filter == SPACEABLE_STAVES && spaceable) + || (filter == NONSPACEABLE_STAVES && !spaceable))) + { + *tail = scm_cons (staves[i]->self_scm (), SCM_EOL); + tail = SCM_CDRLOC (*tail); + } + } + } + + return ret; +} + +MAKE_SCHEME_CALLBACK (System, get_staves, 1) +SCM +System::get_staves (SCM smob) +{ + return get_maybe_spaceable_staves (smob, ALL_STAVES); +} + +MAKE_SCHEME_CALLBACK (System, get_spaceable_staves, 1) +SCM +System::get_spaceable_staves (SCM smob) +{ + return get_maybe_spaceable_staves (smob, SPACEABLE_STAVES); +} + +MAKE_SCHEME_CALLBACK (System, get_nonspaceable_staves, 1) +SCM +System::get_nonspaceable_staves (SCM smob) +{ + return get_maybe_spaceable_staves (smob, NONSPACEABLE_STAVES); +} + + ADD_INTERFACE (System, "This is the top-level object: Each object in a score" " ultimately has a @code{System} object as its X and" diff --git a/scm/paper-system.scm b/scm/paper-system.scm index 9e9f9ab7d4..d60836199d 100644 --- a/scm/paper-system.scm +++ b/scm/paper-system.scm @@ -17,7 +17,9 @@ (define-module (scm paper-system)) -(use-modules (lily)) +(use-modules (lily) + (srfi srfi-1) + (ice-9 optargs)) (define-public (paper-system-title? system) (equal? #t (ly:prob-property system 'is-title) @@ -66,46 +68,182 @@ stencil) )) -; TODO: annotate the spacing for every spaceable staff within the system. + +;; Y-ext and next-Y-ext are either skyline-pairs or extents +(define*-public (annotate-padding system-Y system-X Y-ext X-ext + next-system-Y next-system-X next-Y-ext next-X-ext + layout horizon-padding padding #:key (base-color blue)) + (let* ((eps 0.001) + (skyline (and (ly:skyline-pair? Y-ext) + (ly:skyline-pair::skyline Y-ext DOWN))) + (next-skyline (and (ly:skyline-pair? next-Y-ext) + (ly:skyline-pair::skyline next-Y-ext UP))) + (annotation-X (cond + ((and skyline next-skyline) + (- + (ly:skyline::get-touching-point skyline next-skyline horizon-padding) + horizon-padding)) + (skyline + (ly:skyline::get-max-height-position skyline)) + (next-skyline + (ly:skyline::get-max-height-position next-skyline)) + (else + (max (cdr X-ext) + (cdr next-X-ext))))) + (annotation-Y (if skyline + (ly:skyline::get-height skyline annotation-X) + (car Y-ext))) + (next-annotation-Y (if next-skyline + (- (+ (ly:skyline::get-height next-skyline + (- (+ annotation-X system-X) + next-system-X)) + next-system-Y) + system-Y) + (cdr next-Y-ext))) + (padding-blocks (>= next-annotation-Y (- annotation-Y padding eps))) + (contrast-color (append (cdr base-color) (list (car base-color)))) + (color (if padding-blocks contrast-color base-color)) + (annotation (ly:stencil-translate-axis + (annotate-y-interval + layout + "padding" + `(,(- annotation-Y padding). ,annotation-Y) + #t + #:color color) + annotation-X X))) + (if (> padding 0.0) + annotation + empty-stencil))) + + (define-public (paper-system-annotate system next-system layout) "Add arrows and texts to indicate which lengths are set." - (let* ((annotations (list)) - (grob (ly:prob-property system 'system-grob)) + + (let* ((grob (ly:prob-property system 'system-grob)) + (paper-height (ly:output-def-lookup layout 'paper-height)) + (bottom-margin (ly:output-def-lookup layout 'bottom-margin)) + (top-margin (ly:output-def-lookup layout 'top-margin)) + (spaceable-staves (if (ly:grob? grob) (ly:system::get-spaceable-staves grob) '())) + (all-staves (if (ly:grob? grob) (ly:system::get-staves grob) '())) + (spaceable-staff-annotate + (lambda (before-staff after-staff) + (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y)) + (after-Y (ly:grob-relative-coordinate after-staff grob Y))) + (annotate-spacing-spec + layout + (ly:get-spacing-spec before-staff after-staff) + before-Y + after-Y)))) + + (staff-padding-annotate + (lambda (before-staff after-staff) + (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y)) + (before-X (ly:grob-relative-coordinate before-staff grob X)) + (before-X-ext (ly:grob-extent before-staff before-staff X)) + (after-Y (ly:grob-relative-coordinate after-staff grob Y)) + (after-X (ly:grob-relative-coordinate after-staff grob X)) + (after-X-ext (ly:grob-extent after-staff after-staff X)) + (skylines (ly:grob-property before-staff 'vertical-skylines)) + (after-skylines (ly:grob-property after-staff 'vertical-skylines)) + (padding (assoc-get 'padding + (ly:get-spacing-spec before-staff after-staff) + 0.0)) + (horizon-padding (ly:grob-property before-staff + 'skyline-horizontal-padding + 0.0))) + (ly:stencil-translate + (annotate-padding + before-Y before-X skylines before-X-ext + after-Y after-X after-skylines after-X-ext + layout horizon-padding padding) + (cons before-X before-Y))))) + + (staff-annotations (if (< 1 (length spaceable-staves)) + (map spaceable-staff-annotate + (drop-right spaceable-staves 1) + (drop spaceable-staves 1)) + '())) + (staff-padding-annotations (if (< 1 (length all-staves)) + (map staff-padding-annotate + (drop-right all-staves 1) + (drop all-staves 1)) + '())) (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 + #f)) + + (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)) + ((ly:prob-property system 'last-in-score #f) + (ly:output-def-lookup layout 'score-system-spacing)) + (else + (ly:output-def-lookup layout 'system-system-spacing)))) + (last-staff-Y (car (paper-system-staff-extents system))) + (system-Y (ly:prob-property system 'Y-offset 0.0)) + (system-X (ly:prob-property system 'X-offset 0.0)) + (next-system-Y (and next-system + (ly:prob-property next-system 'Y-offset 0.0))) + (next-system-X (and next-system + (ly:prob-property next-system 'X-offset 0.0))) + (first-staff-next-system-Y (if next-system + (- (+ (cdr (paper-system-staff-extents next-system)) + system-Y) + next-system-Y) + (+ system-Y top-margin bottom-margin (- paper-height)))) + + (skyline (or + (ly:prob-property system 'vertical-skylines #f) + (paper-system-extent system Y))) + (next-skyline (and next-system + (or + (ly:prob-property next-system 'vertical-skylines #f) + (paper-system-extent next-system Y)))) + (horizon-padding (and + (ly:grob? grob) + (ly:grob-property grob 'skyline-horizontal-padding 0))) + (padding-annotation (if next-system + (annotate-padding + (- system-Y) system-X skyline (paper-system-extent system X) + (- next-system-Y) next-system-X next-skyline (paper-system-extent next-system X) + layout + horizon-padding + (assoc-get 'padding spacing-spec 0.0) + #:base-color blue) + empty-stencil)) + + (system-annotation (annotate-spacing-spec + layout spacing-spec + last-staff-Y + first-staff-next-system-Y)) + (annotations (ly:stencil-add + padding-annotation + (stack-stencils Y DOWN 0.0 staff-padding-annotations) + (stack-stencils Y DOWN 0.0 (append staff-annotations (list system-annotation)))))) + + (if estimate-extent (set! annotations - (stack-stencils X RIGHT 0.5 + (stack-stencils X RIGHT 5.5 (list annotations estimate-extent)))) - - (if (not (null? annotations)) - (set! (ly:prob-property system 'stencil) - (ly:stencil-add - (ly:prob-property system 'stencil) - (ly:make-stencil - (ly:stencil-expr annotations) - (ly:stencil-extent empty-stencil X) - (ly:stencil-extent empty-stencil Y))))) - (ly:prob-property system 'stencil))) + + (if (not (null? annotations)) + (set! (ly:prob-property system 'stencil) + (ly:stencil-add + (ly:prob-property system 'stencil) + (ly:make-stencil + (ly:stencil-expr annotations) + (ly:stencil-extent empty-stencil X) + (ly:stencil-extent empty-stencil Y))))) + (ly:prob-property system 'stencil))) diff --git a/scm/stencil.scm b/scm/stencil.scm index 2f31d343f5..79197e8744 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -658,43 +658,43 @@ with optional arrows of @code{max-size} on start and end controlled by (center-stencil-on-extent dim-stencil) 0.5)) (set! annotation - (ly:make-stencil (list 'color color (ly:stencil-expr annotation)) - (ly:stencil-extent annotation X) - (cons 10000 -10000))))) + (stencil-with-color annotation color)))) annotation)) -(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset prev-system-end +;; TODO: figure out how to annotate padding nicely +;; TODO: emphasize either padding or min-dist depending on which constraint was active +(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset next-staff-Y #:key (base-color blue)) - (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0))) - (space (get-spacing-var 'space)) + (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0))) + (space (get-spacing-var 'basic-distance)) (padding (get-spacing-var 'padding)) (min-dist (get-spacing-var 'minimum-distance)) - (contrast-color (append (cdr base-color) (list (car base-color))))) + (contrast-color (append (cdr base-color) (list (car base-color)))) + (min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y)) + (min-dist-color (if min-dist-blocks contrast-color base-color)) + (basic-annotation (annotate-y-interval layout + "basic-dist" + (cons (- start-Y-offset space) start-Y-offset) + #t + #:color (map (lambda (x) (* x 0.25)) base-color))) + (min-annotation (annotate-y-interval layout + "min-dist" + (cons (- start-Y-offset min-dist) start-Y-offset) + #t + #:color min-dist-color)) + (extra-annotation (annotate-y-interval layout + "extra dist" + (cons next-staff-Y (- start-Y-offset min-dist)) + #t + #:color (map (lambda (x) (* x 0.5)) min-dist-color)))) + (stack-stencils X RIGHT 0.0 (list - (annotate-y-interval layout - "space" - (cons (- start-Y-offset space) start-Y-offset) - #t - #:color (map (lambda (x) (* x 0.25)) base-color)) - (annotate-y-interval layout - "min-dist" - (cons (- start-Y-offset min-dist) start-Y-offset) - #t - #:color (map (lambda (x) (* x 0.5)) base-color)) - (ly:stencil-add - (annotate-y-interval layout - "bottom-of-extent" - (cons prev-system-end start-Y-offset) - #t - #:color base-color) - (annotate-y-interval layout - "padding" - (cons (- prev-system-end padding) prev-system-end) - #t - #:color contrast-color)))))) - + basic-annotation + (if min-dist-blocks + min-annotation + (ly:stencil-add min-annotation extra-annotation)))))) (define-public (eps-file->stencil axis size file-name) (let*