Index: lily/grob-closure.cc =================================================================== RCS file: /sources/lilypond/lilypond/lily/grob-closure.cc,v retrieving revision 1.6 diff -u -r1.6 grob-closure.cc --- lily/grob-closure.cc 3 Oct 2006 12:00:18 -0000 1.6 +++ lily/grob-closure.cc 22 Oct 2006 07:37:33 -0000 @@ -80,7 +80,7 @@ Data may be nonnumber. In that case, it is assumed to be undefined. */ - + data = SCM_UNDEFINED; SCM expr = scm_list_2 (proc, data); Index: lily/grob-property.cc =================================================================== RCS file: /sources/lilypond/lilypond/lily/grob-property.cc,v retrieving revision 1.55 diff -u -r1.55 grob-property.cc --- lily/grob-property.cc 23 Sep 2006 22:51:56 -0000 1.55 +++ lily/grob-property.cc 22 Oct 2006 07:37:33 -0000 @@ -171,7 +171,8 @@ else if (is_simple_closure (proc)) { value = evaluate_with_simple_closure (self_scm (), - simple_closure_expression (proc)); + simple_closure_expression (proc), + false, 0, 0); } #ifndef NDEBUG if (debug_property_callbacks) @@ -229,9 +230,17 @@ return scm_is_pair (immutable_property_alist_); } - bool Grob::internal_has_interface (SCM k) { return scm_c_memq (k, interfaces_) != SCM_BOOL_F; } + +SCM +call_pure_function (SCM unpure, SCM args, int start, int end) +{ + SCM scm_call_pure_function = ly_lily_module_constant ("call-pure-function"); + + return scm_apply_0 (scm_call_pure_function, + scm_list_4 (unpure, args, scm_from_int (start), scm_from_int (end))); +} Index: lily/grob.cc =================================================================== RCS file: /sources/lilypond/lilypond/lily/grob.cc,v retrieving revision 1.179 diff -u -r1.179 grob.cc --- lily/grob.cc 10 Oct 2006 08:32:59 -0000 1.179 +++ lily/grob.cc 22 Oct 2006 07:37:34 -0000 @@ -287,17 +287,19 @@ if (refp == this) return 0.0; - SCM pure_off = ly_lily_module_constant ("pure-Y-offset"); Real off = 0; if (dim_cache_[Y_AXIS].offset_) off = *dim_cache_[Y_AXIS].offset_; - else if (ly_is_procedure (pure_off)) + else { + SCM proc = get_property_data (ly_symbol2scm ("Y-offset")); + dim_cache_[Y_AXIS].offset_ = new Real (0.0); - off = scm_to_double (scm_apply_3 (pure_off, self_scm (), - scm_from_int (start), scm_from_int (end), - SCM_EOL)); + off = robust_scm2double (call_pure_function (proc, + scm_list_1 (self_scm ()), + start, end), + 0.0); delete dim_cache_[Y_AXIS].offset_; dim_cache_[Y_AXIS].offset_ = 0; } @@ -404,6 +406,7 @@ SCM min_ext = internal_get_property (min_ext_sym); if (is_number_pair (min_ext)) real_ext.unite (ly_scm2interval (min_ext)); + ((Grob*)this)->dim_cache_[a].extent_ = new Interval (real_ext); } @@ -415,13 +418,11 @@ Interval Grob::pure_height (Grob *refp, int start, int end) { - SCM pure_height = ly_lily_module_constant ("pure-Y-extent"); - Interval iv (0, 0); - - if (ly_is_procedure (pure_height)) - iv = ly_scm2interval (scm_apply_3 (pure_height, self_scm (), - scm_from_int (start), scm_from_int (end), - SCM_EOL)); + SCM proc = get_property_data ( ly_symbol2scm ("Y-extent")); + Interval iv = robust_scm2interval (call_pure_function (proc, + scm_list_1 (self_scm ()), + start, end), + Interval (0, 0)); Real offset = pure_relative_y_coordinate (refp, start, end); SCM min_ext = get_property ("minimum-Y-extent"); Index: lily/side-position-interface.cc =================================================================== RCS file: /sources/lilypond/lilypond/lily/side-position-interface.cc,v retrieving revision 1.126 diff -u -r1.126 side-position-interface.cc --- lily/side-position-interface.cc 3 Oct 2006 12:00:18 -0000 1.126 +++ lily/side-position-interface.cc 22 Oct 2006 07:37:34 -0000 @@ -190,11 +190,14 @@ return axis_aligned_side_helper (smob, Y_AXIS, false, 0, 0, current_off); } -MAKE_SCHEME_CALLBACK (Side_position_interface, pure_y_aligned_side, 3); +MAKE_SCHEME_CALLBACK_WITH_OPTARGS (Side_position_interface, pure_y_aligned_side, 4, 1); SCM -Side_position_interface::pure_y_aligned_side (SCM smob, SCM start, SCM end) +Side_position_interface::pure_y_aligned_side (SCM smob, SCM start, SCM end, SCM cur_off) { - return aligned_side (unsmob_grob (smob), Y_AXIS, true, scm_to_int (start), scm_to_int (end), 0); + return axis_aligned_side_helper (smob, Y_AXIS, true, + scm_to_int (start), + scm_to_int (end), + cur_off); } SCM Index: lily/simple-closure.cc =================================================================== RCS file: /sources/lilypond/lilypond/lily/simple-closure.cc,v retrieving revision 1.5 diff -u -r1.5 simple-closure.cc --- lily/simple-closure.cc 3 Oct 2006 12:00:18 -0000 1.5 +++ lily/simple-closure.cc 22 Oct 2006 07:37:34 -0000 @@ -6,7 +6,9 @@ (c) 2005--2006 Han-Wen Nienhuys */ +#include "simple-closure.hh" +#include "grob.hh" #include "lily-guile.hh" static scm_t_bits simple_closure_tag; @@ -24,17 +26,18 @@ return (SCM) SCM_CELL_WORD_1(smob); } -SCM evaluate_with_simple_closure (SCM delayed_argument, SCM expr); - SCM -evaluate_args (SCM delayed_argument, SCM args) +evaluate_args (SCM delayed_argument, SCM args, bool pure, int start, int end) { SCM new_args = SCM_EOL; SCM *tail = &new_args; for (SCM s = args; scm_is_pair (s); s = scm_cdr (s)) { - *tail = scm_cons (evaluate_with_simple_closure (delayed_argument, scm_car (s)), + *tail = scm_cons (evaluate_with_simple_closure (delayed_argument, scm_car (s), + pure, start, end), SCM_EOL); + if (scm_car (*tail) == SCM_UNSPECIFIED) + return SCM_UNSPECIFIED; tail = SCM_CDRLOC (*tail); } @@ -43,14 +46,22 @@ SCM evaluate_with_simple_closure (SCM delayed_argument, - SCM expr) + SCM expr, + bool pure, + int start, + int end) { if (is_simple_closure (expr)) { SCM inside = simple_closure_expression (expr); - return scm_apply_1 (scm_car (inside), - delayed_argument, - evaluate_args (delayed_argument, scm_cdr (inside))); + SCM args = scm_cons (delayed_argument, + evaluate_args (delayed_argument, scm_cdr (inside), + pure, start, end)); + if (scm_cdr (args) == SCM_UNSPECIFIED) + return SCM_UNSPECIFIED; + if (pure) + return call_pure_function (scm_car (inside), args, start, end); + return scm_apply_0 (scm_car (inside), args); } else if (!scm_is_pair (expr)) return expr; @@ -58,12 +69,16 @@ return scm_cadr (expr); else if (ly_is_procedure (scm_car (expr))) { - return scm_apply_0 (scm_car (expr), - evaluate_args (delayed_argument, scm_cdr (expr))); + SCM args = evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end); + if (args == SCM_UNSPECIFIED) + return SCM_UNSPECIFIED; + if (pure) + return call_pure_function (scm_car (expr), args, start, end); + return scm_apply_0 (scm_car (expr), args); } else // ugh. deviation from standard. Should print error? - return evaluate_args (delayed_argument, scm_cdr (expr)); + return evaluate_args (delayed_argument, scm_cdr (expr), pure, start, end); assert (false); return SCM_EOL; @@ -87,6 +102,19 @@ SCM_NEWSMOB(z, simple_closure_tag, expr); return z; } + +LY_DEFINE(ly_eval_simple_closure, "ly:eval-simple-closure", + 2, 2, 0, (SCM delayed, SCM closure, SCM scm_start, SCM scm_end), + "Evaluate a simple closure with the given delayed argument. " + "If start and end are defined, evaluate it purely with those " + "start- and end-points.") +{ + bool pure = (scm_is_number (scm_start) && scm_is_number (scm_end)); + int start = robust_scm2int (scm_start, 0); + int end = robust_scm2int (scm_end, 0); + SCM expr = simple_closure_expression (closure); + return evaluate_with_simple_closure (delayed, expr, pure, start, end); +} int print_simple_closure (SCM s, SCM port, scm_print_state *) Index: lily/slur.cc =================================================================== RCS file: /sources/lilypond/lilypond/lily/slur.cc,v retrieving revision 1.251 diff -u -r1.251 slur.cc --- lily/slur.cc 3 Oct 2006 12:00:18 -0000 1.251 +++ lily/slur.cc 22 Oct 2006 07:37:34 -0000 @@ -185,6 +185,25 @@ Pointer_group_interface::add_grob (me, ly_symbol2scm ("encompass-objects"), n); } +MAKE_SCHEME_CALLBACK_WITH_OPTARGS (Slur, pure_outside_slur_callback, 4, 1); +SCM +Slur::pure_outside_slur_callback (SCM grob, SCM start_scm, SCM end_scm, SCM offset_scm) +{ + int start = robust_scm2int (start_scm, 0); + int end = robust_scm2int (end_scm, 0); + Grob *script = unsmob_grob (grob); + Grob *slur = unsmob_grob (script->get_object ("slur")); + if (!slur) + return offset_scm; + + SCM avoid = script->get_property ("avoid-slur"); + if (avoid != ly_symbol2scm ("outside") && avoid != ly_symbol2scm ("around")) + return offset_scm; + + Real offset = robust_scm2double (offset_scm, 0.0); + Direction dir = get_grob_direction (script); + return scm_from_double (offset + dir * slur->pure_height (slur, start, end).length () / 4); +} MAKE_SCHEME_CALLBACK_WITH_OPTARGS (Slur, outside_slur_callback, 2, 1); SCM Index: lily/include/grob.hh =================================================================== RCS file: /sources/lilypond/lilypond/lily/include/grob.hh,v retrieving revision 1.83 diff -u -r1.83 grob.hh --- lily/include/grob.hh 15 Oct 2006 11:30:06 -0000 1.83 +++ lily/include/grob.hh 22 Oct 2006 07:37:34 -0000 @@ -151,4 +151,6 @@ SCM axis_offset_symbol (Axis a); SCM axis_parent_positioning (Axis a); +SCM call_pure_function (SCM unpure, SCM args, int start, int end); + #endif /* GROB_HH */ Index: lily/include/lily-guile.hh =================================================================== RCS file: /sources/lilypond/lilypond/lily/include/lily-guile.hh,v retrieving revision 1.177 diff -u -r1.177 lily-guile.hh --- lily/include/lily-guile.hh 17 Sep 2006 11:02:29 -0000 1.177 +++ lily/include/lily-guile.hh 22 Oct 2006 07:37:35 -0000 @@ -183,5 +183,4 @@ inline SCM ly_cdr (SCM x) { return SCM_CDR (x); } inline bool ly_is_pair (SCM x) { return SCM_I_CONSP (x); } - #endif /* LILY_GUILE_HH */ Index: lily/include/side-position-interface.hh =================================================================== RCS file: /sources/lilypond/lilypond/lily/include/side-position-interface.hh,v retrieving revision 1.35 diff -u -r1.35 side-position-interface.hh --- lily/include/side-position-interface.hh 3 Oct 2006 12:00:18 -0000 1.35 +++ lily/include/side-position-interface.hh 22 Oct 2006 07:37:35 -0000 @@ -25,7 +25,7 @@ DECLARE_SCHEME_CALLBACK (pure_y_aligned_on_support_refpoints, (SCM element, SCM start, SCM end)); DECLARE_SCHEME_CALLBACK (x_aligned_side, (SCM element, SCM current)); DECLARE_SCHEME_CALLBACK (y_aligned_side, (SCM element, SCM current)); - DECLARE_SCHEME_CALLBACK (pure_y_aligned_side, (SCM element, SCM start, SCM end)); + DECLARE_SCHEME_CALLBACK (pure_y_aligned_side, (SCM element, SCM start, SCM end, SCM current)); static SCM aligned_side (Grob*me, Axis a, bool pure, int start, int end, Real *current_off_ptr); Index: lily/include/simple-closure.hh =================================================================== RCS file: /sources/lilypond/lilypond/lily/include/simple-closure.hh,v retrieving revision 1.2 diff -u -r1.2 simple-closure.hh --- lily/include/simple-closure.hh 6 Jan 2006 09:13:24 -0000 1.2 +++ lily/include/simple-closure.hh 22 Oct 2006 07:37:35 -0000 @@ -10,9 +10,11 @@ #ifndef SIMPLE_CLOSURE_HH #define SIMPLE_CLOSURE_HH +#include "lily-guile.hh" + bool is_simple_closure (SCM s); SCM simple_closure_expression (SCM smob); -SCM evaluate_with_simple_closure (SCM delayed_argument, SCM expr); +SCM evaluate_with_simple_closure (SCM delayed_argument, SCM expr, bool pure, int start, int end); SCM ly_make_simple_closure (SCM); #endif /* SIMPLE_CLOSURE_HH */ Index: lily/include/slur.hh =================================================================== RCS file: /sources/lilypond/lilypond/lily/include/slur.hh,v retrieving revision 1.71 diff -u -r1.71 slur.hh --- lily/include/slur.hh 4 Sep 2006 05:31:28 -0000 1.71 +++ lily/include/slur.hh 22 Oct 2006 07:37:35 -0000 @@ -26,6 +26,7 @@ DECLARE_SCHEME_CALLBACK (pure_height, (SCM, SCM, SCM)); DECLARE_SCHEME_CALLBACK (height, (SCM)); DECLARE_SCHEME_CALLBACK (outside_slur_callback, (SCM, SCM)); + DECLARE_SCHEME_CALLBACK (pure_outside_slur_callback, (SCM, SCM, SCM, SCM)); static bool has_interface (Grob *); static Bezier get_curve (Grob *me); }; Index: ly/paper-defaults.ly =================================================================== RCS file: /sources/lilypond/lilypond/ly/paper-defaults.ly,v retrieving revision 1.30 diff -u -r1.30 paper-defaults.ly --- ly/paper-defaults.ly 18 Oct 2006 10:07:11 -0000 1.30 +++ ly/paper-defaults.ly 22 Oct 2006 07:37:35 -0000 @@ -80,7 +80,7 @@ %% settings for the page breaker %% blank-last-page-force = 0 - blank-page-force = 10 + blank-page-force = 2 #(define font-defaults '((font-encoding . fetaMusic))) Index: scm/define-grobs.scm =================================================================== RCS file: /sources/lilypond/lilypond/scm/define-grobs.scm,v retrieving revision 1.373 diff -u -r1.373 define-grobs.scm --- scm/define-grobs.scm 21 Oct 2006 10:45:15 -0000 1.373 +++ scm/define-grobs.scm 22 Oct 2006 07:37:36 -0000 @@ -2037,72 +2037,57 @@ (define pure-print-callbacks (list - `(,ly:note-head::print . '()) - `(,ly:clef::print . '()) - `(,ly:text-interface::print . '()) - `(,ly:script-interface::print . '()))) + ly:note-head::print + ly:clef::print + ly:text-interface::print + ly:script-interface::print)) ;; ly:grob::stencil-extent is safe iff the print callback is safe too (define (pure-stencil-height grob start stop) (let ((sten (ly:grob-property-data grob 'stencil))) (if (or (ly:stencil? sten) - (pair? (assq sten pure-print-callbacks))) + (memq sten pure-print-callbacks)) (ly:grob::stencil-height grob) '(0 . 0)))) -(define pure-Y-extents - (list - `(,ly:staff-symbol::height . ()))) - -(define Y-extent-conversions +(define pure-conversions-alist (list + `(,ly:slur::outside-slur-callback . ,ly:slur::pure-outside-slur-callback) `(,ly:stem::height . ,ly:stem::pure-height) `(,ly:grob::stencil-height . ,pure-stencil-height) `(,ly:side-position-interface::y-aligned-side . ,ly:side-position-interface::pure-y-aligned-side) `(,ly:axis-group-interface::height . ,ly:axis-group-interface::pure-height) `(,ly:hara-kiri-group-spanner::y-extent . ,ly:hara-kiri-group-spanner::pure-height) - `(,ly:slur::height . ,ly:slur::pure-height))) - -(define pure-Y-offsets - (list - `(,ly:staff-symbol-referencer::callback . ()))) + `(,ly:slur::height . ,ly:slur::pure-height) + `(,ly:side-position-interface::y-aligned-side . ,ly:side-position-interface::pure-y-aligned-side))) -(define Y-offset-conversions +(define pure-functions (list - `(,ly:side-position-interface::y-aligned-side . ,ly:side-position-interface::pure-y-aligned-side))) + ly:staff-symbol-referencer::callback + ly:staff-symbol::height)) (define-public (pure-relevant grob) (let ((extent-callback (ly:grob-property-data grob 'Y-extent))) - (or - (pair? extent-callback) - (pair? (assq extent-callback pure-Y-extents)) - (and - (pair? (assq extent-callback Y-extent-conversions)) - (or - (not (eq? extent-callback ly:grob::stencil-height)) - (pair? (assq (ly:grob-property-data grob 'stencil) pure-print-callbacks)) - (ly:stencil? (ly:grob-property-data grob 'stencil))))))) - -(define (pure-conversion pures conversions defsymbol defreturn rettype? grob start stop) - (let* ((normal-callback (ly:grob-property-data grob defsymbol)) - ) - - (if (rettype? normal-callback) - normal-callback - (if (pair? (assq normal-callback pures)) - (normal-callback grob) - (let - ((pure-callback (assq normal-callback conversions))) - - (if (pair? pure-callback) - ((cdr pure-callback) grob start stop) - defreturn)))))) - -(define-public (pure-Y-extent grob start stop) - (pure-conversion pure-Y-extents Y-extent-conversions - 'Y-extent '(0 . 0) pair? grob start stop)) - -(define-public (pure-Y-offset grob start stop) - (pure-conversion pure-Y-offsets Y-offset-conversions - 'Y-offset 0 number? grob start stop)) + (not (eq? #f + (or + (pair? extent-callback) + (memq extent-callback pure-functions) + (and + (pair? (assq extent-callback pure-conversions-alist)) + (begin + (or + (not (eq? extent-callback ly:grob::stencil-height)) + (memq (ly:grob-property-data grob 'stencil) pure-print-callbacks) + (ly:stencil? (ly:grob-property-data grob 'stencil)))))))))) + +(define-public (call-pure-function unpure args start end) + (if (ly:simple-closure? unpure) + (ly:eval-simple-closure (car args) unpure start end) + (if (not (procedure? unpure)) + unpure + (if (memq unpure pure-functions) + (apply unpure args) + (let ((pure (assq unpure pure-conversions-alist))) + (if pure + (apply (cdr pure) (append (list (car args) start end) (cdr args)))))))))