From 8e79b6a256018e5d9b687e411d472711847ad90e Mon Sep 17 00:00:00 2001 From: Joe Neeman Date: Tue, 24 Oct 2006 19:11:46 +0000 Subject: [PATCH] * lily/grob.cc (pure_relative_y_coordinate) (pure_height): use the new call_pure_function stuff * lily/grob-property.cc (call_pure_function): wrapper for the scheme call-pure-function * lily/side-position-interface.cc (pure_y_aligned_side): add an optarg * lily/simple-closure.cc (ly_eval_simple_closure): make simple-closure evaluatable from scheme (evaluate_with_simple_closure): make simple-closures pure- evaluatable * lily/slur.cc (pure_outside_slur_callback): new function * ly/paper-defaults.ly: change default blank-page-force to 2 (this fits in with previous changes that made the page forces much smaller) * scm/define-grobs.scm (call-pure-function): generalise pure-Y-offset and pure-Y-extent into this new function. (pure-conversions-alist): add outside-slur-callback --- ChangeLog | 26 ++++++++ lily/grob-closure.cc | 2 +- lily/grob-property.cc | 13 +++- lily/grob.cc | 25 ++++---- lily/include/grob.hh | 2 + lily/include/lily-guile.hh | 1 - lily/include/side-position-interface.hh | 2 +- lily/include/simple-closure.hh | 4 +- lily/include/slur.hh | 1 + lily/side-position-interface.cc | 9 ++- lily/simple-closure.cc | 50 +++++++++++---- lily/slur.cc | 19 ++++++ ly/paper-defaults.ly | 2 +- scm/define-grobs.scm | 83 ++++++++++--------------- 14 files changed, 157 insertions(+), 82 deletions(-) diff --git a/ChangeLog b/ChangeLog index 691c9aa258..c5de55225d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,29 @@ +2006-10-24 Joe Neeman + + * lily/grob.cc (pure_relative_y_coordinate) + (pure_height): use the new call_pure_function stuff + + * lily/grob-property.cc (call_pure_function): wrapper for the scheme + call-pure-function + + * lily/side-position-interface.cc (pure_y_aligned_side): add an + optarg + + * lily/simple-closure.cc (ly_eval_simple_closure): make + simple-closure evaluatable from scheme + (evaluate_with_simple_closure): make simple-closures pure- + evaluatable + + * lily/slur.cc (pure_outside_slur_callback): new function + + * ly/paper-defaults.ly: change default blank-page-force to 2 (this + fits in with previous changes that made the page forces much + smaller) + + * scm/define-grobs.scm (call-pure-function): generalise pure-Y-offset + and pure-Y-extent into this new function. + (pure-conversions-alist): add outside-slur-callback + 2006-10-24 Mats Bengtsson * Documentation/user/advanced-notation.itely (Instrument names): diff --git a/lily/grob-closure.cc b/lily/grob-closure.cc index 5e4035f7e8..b2d0160ada 100644 --- a/lily/grob-closure.cc +++ b/lily/grob-closure.cc @@ -80,7 +80,7 @@ chain_offset_callback (Grob *g, SCM proc, Axis a) Data may be nonnumber. In that case, it is assumed to be undefined. */ - + data = SCM_UNDEFINED; SCM expr = scm_list_2 (proc, data); diff --git a/lily/grob-property.cc b/lily/grob-property.cc index 3924f4ece9..703f0055e8 100644 --- a/lily/grob-property.cc +++ b/lily/grob-property.cc @@ -171,7 +171,8 @@ Grob::try_callback (SCM sym, SCM proc) 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 @@ Grob::is_live () const 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))); +} diff --git a/lily/grob.cc b/lily/grob.cc index dd8726cac8..b3d117e3f5 100644 --- a/lily/grob.cc +++ b/lily/grob.cc @@ -287,17 +287,19 @@ Grob::pure_relative_y_coordinate (Grob const *refp, int start, int end) 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 @@ Grob::extent (Grob *refp, Axis a) const 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 @@ Grob::extent (Grob *refp, Axis a) const 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"); diff --git a/lily/include/grob.hh b/lily/include/grob.hh index 2ecac8bc4f..16b0c3f545 100644 --- a/lily/include/grob.hh +++ b/lily/include/grob.hh @@ -151,4 +151,6 @@ void chain_offset_callback (Grob *g, SCM proc, Axis a); 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 */ diff --git a/lily/include/lily-guile.hh b/lily/include/lily-guile.hh index 07abff74ef..19a8dbd43f 100644 --- a/lily/include/lily-guile.hh +++ b/lily/include/lily-guile.hh @@ -183,5 +183,4 @@ inline SCM ly_car (SCM x) { return SCM_CAR (x); } 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 */ diff --git a/lily/include/side-position-interface.hh b/lily/include/side-position-interface.hh index 36b1e8fdf5..fd58027a88 100644 --- a/lily/include/side-position-interface.hh +++ b/lily/include/side-position-interface.hh @@ -25,7 +25,7 @@ public: 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); diff --git a/lily/include/simple-closure.hh b/lily/include/simple-closure.hh index 1bddb853e6..e5a3aed78a 100644 --- a/lily/include/simple-closure.hh +++ b/lily/include/simple-closure.hh @@ -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 */ diff --git a/lily/include/slur.hh b/lily/include/slur.hh index f0213372bc..20667dd25c 100644 --- a/lily/include/slur.hh +++ b/lily/include/slur.hh @@ -26,6 +26,7 @@ public: 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); }; diff --git a/lily/side-position-interface.cc b/lily/side-position-interface.cc index 38880cb52e..73854bdc40 100644 --- a/lily/side-position-interface.cc +++ b/lily/side-position-interface.cc @@ -190,11 +190,14 @@ Side_position_interface::y_aligned_side (SCM smob, SCM current_off) 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 diff --git a/lily/simple-closure.cc b/lily/simple-closure.cc index 77764b2bc6..139478983a 100644 --- a/lily/simple-closure.cc +++ b/lily/simple-closure.cc @@ -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 @@ simple_closure_expression (SCM smob) 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 @@ evaluate_args (SCM delayed_argument, SCM args) 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 @@ evaluate_with_simple_closure (SCM delayed_argument, 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 @@ LY_DEFINE(ly_make_simple_closure, "ly:make-simple-closure", 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 *) diff --git a/lily/slur.cc b/lily/slur.cc index d8c81f7836..0128e8cdfd 100644 --- a/lily/slur.cc +++ b/lily/slur.cc @@ -185,6 +185,25 @@ Slur::add_extra_encompass (Grob *me, Grob *n) 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 diff --git a/ly/paper-defaults.ly b/ly/paper-defaults.ly index 357692c44a..14d333c9cb 100644 --- a/ly/paper-defaults.ly +++ b/ly/paper-defaults.ly @@ -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))) diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index 99492119c7..352256d817 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -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))))))))) -- 2.39.5