From f01b62400572ea7fe1b4f7511a2b3a33d8e42cdb Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 2 Nov 2005 01:09:02 +0000 Subject: [PATCH] * scm/output-lib.scm (chain-grob-member-functions): replace chained-callback.cc * lily/chained-callback.cc (Module): remove file. * lily/simple-closure.cc: new file. Smob type that allows "grob member functions", --- ChangeLog | 9 ++++- lily/chained-callback.cc | 83 ---------------------------------------- lily/grob-property.cc | 8 ---- lily/include/grob.hh | 3 -- lily/simple-closure.cc | 12 ++++-- scm/define-grobs.scm | 19 +++++---- scm/output-lib.scm | 11 ++++++ 7 files changed, 37 insertions(+), 108 deletions(-) delete mode 100644 lily/chained-callback.cc diff --git a/ChangeLog b/ChangeLog index 5ebd409846..d56a8b53ab 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2005-11-02 Han-Wen Nienhuys + * scm/output-lib.scm (chain-grob-member-functions): replace + chained-callback.cc + + * lily/chained-callback.cc (Module): remove file. + * lily/rest-collision.cc (force_shift_callback_rest): change to chained callback. @@ -21,8 +26,8 @@ * lily/include/dimension-cache.hh (class Dimension_cache): remove callback administration. - * lily/simple-closure.cc: new file. Smob type that allows "grob" - member functions + * lily/simple-closure.cc: new file. Smob type that allows "grob + member functions", (ly:make-simple-closure FUNC A B) diff --git a/lily/chained-callback.cc b/lily/chained-callback.cc deleted file mode 100644 index 646c7a4bc2..0000000000 --- a/lily/chained-callback.cc +++ /dev/null @@ -1,83 +0,0 @@ -/* - chained-callback.cc -- chained callbacks. - - source file of the GNU LilyPond music typesetter - - (c) 2005 Han-Wen Nienhuys - -*/ - -#include "lily-guile.hh" - -static scm_t_bits chain_tag; - -bool -is_callback_chain (SCM s) -{ - return (SCM_NIMP (s) && SCM_CELL_TYPE (s) == chain_tag); -} - -SCM -callback_chain_extract_procedures (SCM chain_smob) -{ - assert (is_callback_chain (chain_smob)); - return (SCM) SCM_CELL_WORD_1(chain_smob); -} - -LY_DEFINE(ly_callback_chain_p, "ly:callback-chain?", - 1,0,0, (SCM chain), - "Type predicate.") -{ - return scm_from_bool (is_callback_chain (chain)); -} - -LY_DEFINE(ly_make_callback_chain, "ly:make-callback-chain", - 0, 0, 1, (SCM procedures), - "Make a grob callback chain. @var{procedures} should be a " - "list of procedures taking 2 arguments.") -{ - SCM z; - - for (SCM s = procedures; - scm_is_pair (s); s = scm_cdr (s)) - { - SCM proc = scm_car (s); - if (!ly_is_procedure (proc)) - { - scm_misc_error ("Must be a procedure: ~a", - "ly:make-callback-chain", - proc); - } - - if (procedure_arity (proc) != 2) - { - scm_misc_error ("Procedure should take 2 arguments: ~a", - "ly:make-callback-chain", - proc); - } - } - - SCM_NEWSMOB(z, chain_tag, procedures); - return z; -} - -int -print_callback_chain (SCM s, SCM port, scm_print_state *) -{ - scm_puts ("#", port); - return 1; -} - - -void init_chained_callback () -{ - chain_tag = scm_make_smob_type ("callback-chain", 0); - scm_set_smob_mark (chain_tag, scm_markcdr); - scm_set_smob_print (chain_tag, print_callback_chain); -}; - - - -ADD_SCM_INIT_FUNC(chain, init_chained_callback); diff --git a/lily/grob-property.cc b/lily/grob-property.cc index 3df536b42d..5d4d03fe34 100644 --- a/lily/grob-property.cc +++ b/lily/grob-property.cc @@ -136,14 +136,6 @@ Grob::try_callback (SCM sym, SCM proc) SCM value = SCM_EOL; if (ly_is_procedure (proc)) value = scm_call_1 (proc, self_scm ()); - else if (is_callback_chain (proc)) - { - for (SCM s = callback_chain_extract_procedures (proc); - scm_is_pair (s); s = scm_cdr (s)) - { - value = scm_call_2 (scm_car (s), self_scm (), value); - } - } else if (is_simple_closure (proc)) { value = evaluate_with_simple_closure (self_scm (), diff --git a/lily/include/grob.hh b/lily/include/grob.hh index b969f7478b..4dc2b196c4 100644 --- a/lily/include/grob.hh +++ b/lily/include/grob.hh @@ -136,9 +136,6 @@ SCM ly_grobs2scm (Link_array a); Interval robust_relative_extent (Grob *, Grob *, Axis); -bool is_callback_chain (SCM s); -SCM callback_chain_extract_procedures (SCM chain_smob); - SCM axis_offset_symbol (Axis a); SCM axis_self_offset_symbol (Axis a); diff --git a/lily/simple-closure.cc b/lily/simple-closure.cc index 8a32a02871..122b1f2a78 100644 --- a/lily/simple-closure.cc +++ b/lily/simple-closure.cc @@ -56,11 +56,15 @@ evaluate_with_simple_closure (SCM delayed_argument, return expr; else if (scm_car (expr) == ly_symbol2scm ("quote")) return scm_cadr (expr); - else + else if (ly_is_procedure (scm_car (expr))) { - return scm_apply_0 (scm_car (expr), evaluate_args (delayed_argument, scm_cdr (expr))); + return scm_apply_0 (scm_car (expr), + evaluate_args (delayed_argument, scm_cdr (expr))); } - + else + // ugh. deviation from standard. Should print error? + return evaluate_args (delayed_argument, scm_cdr (expr)); + assert (false); return SCM_EOL; } @@ -73,7 +77,7 @@ LY_DEFINE(ly_simple_closure_p, "ly:simple-closure?", } LY_DEFINE(ly_make_simple_closure, "ly:make-simple-closure", - 0, 0, 1, (SCM expr), + 1, 0, 0, (SCM expr), "Make a simple closure. @var{expr} should be form of " "@code{(@var{func} @var{a1} @var{A2} ...)}, and will be invoked " "as @code{(@var{func} @var{delayed-arg} @var{a1} @var{a2} ... )}.") diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index 2cfd8c8e17..55bb3a6546 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -282,14 +282,17 @@ ;; todo: clean this up a bit: the list is getting ;; rather long. (gap . 0.8) - - (positions . ,(ly:make-callback-chain - Beam::calc_least_squares_positions - Beam::slope_damping - Beam::shift_region_to_valid - Beam::quanting - Beam::set_stem_lengths - )) + (positions . ,(ly:make-simple-closure + (ly:make-simple-closure + (list chain-grob-member-functions + `(,cons 0 0) + Beam::calc_least_squares_positions + Beam::slope_damping + Beam::shift_region_to_valid + Beam::quanting + Beam::set_stem_lengths + )))) + (concaveness . ,Beam::calc_concaveness) (direction . ,Beam::calc_direction) (stencil . ,Beam::print) diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 0a9dc19fcc..60896a9304 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -282,3 +282,14 @@ centered, X==1 is at the right, X == -1 is at the left." (ly:stencil-translate-axis lp (- (car x-ext) padding) X) (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X)) )) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; + +(define-public (chain-grob-member-functions grob value . funcs) + (for-each + (lambda (func) + (set! value (func grob value))) + funcs) + + value) -- 2.39.5