Thu Oct 19 14:32:16 IST 2006 Joe Neeman * Refactor the conversion into pure functions. diff -rN -u old-lilypond/lily/grob.cc new-lilypond/lily/grob.cc --- old-lilypond/lily/grob.cc 2006-10-20 18:34:18.000000000 +0200 +++ new-lilypond/lily/grob.cc 2006-10-20 18:34:18.000000000 +0200 @@ -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; } @@ -415,13 +417,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"); diff -rN -u old-lilypond/lily/include/lily-guile.hh new-lilypond/lily/include/lily-guile.hh --- old-lilypond/lily/include/lily-guile.hh 2006-10-20 18:34:18.000000000 +0200 +++ new-lilypond/lily/include/lily-guile.hh 2006-10-20 18:34:18.000000000 +0200 @@ -181,5 +181,6 @@ inline SCM ly_cdr (SCM x) { return SCM_CDR (x); } inline bool ly_is_pair (SCM x) { return SCM_I_CONSP (x); } +SCM call_pure_function (SCM unpure, SCM args, int start, int end); #endif /* LILY_GUILE_HH */ diff -rN -u old-lilypond/lily/lily-guile.cc new-lilypond/lily/lily-guile.cc --- old-lilypond/lily/lily-guile.cc 2006-10-20 18:34:18.000000000 +0200 +++ new-lilypond/lily/lily-guile.cc 2006-10-20 18:34:18.000000000 +0200 @@ -746,3 +746,29 @@ return cxx_id; } +SCM +call_pure_function (SCM unpure, SCM args, int start, int end) +{ + static SCM pures = 0; + static SCM conversions = 0; + if (!pures) + { + pures = ly_lily_module_constant ("pure-functions"); + conversions = ly_lily_module_constant ("pure-conversions-alist"); + } + + if (!ly_is_procedure (unpure)) + return unpure; + + if (scm_memq (unpure, pures) != SCM_BOOL_F) + return scm_apply_0 (unpure, args); + + SCM pure = scm_assq (unpure, conversions); + if (pure != SCM_BOOL_F) + { + SCM newargs = scm_append (scm_list_2 (args, scm_list_2 (scm_from_int (start), + scm_from_int (end)))); + return scm_apply_0 (scm_cdr (pure), newargs); + } + return SCM_UNDEFINED; +} diff -rN -u old-lilypond/ly/paper-defaults.ly new-lilypond/ly/paper-defaults.ly --- old-lilypond/ly/paper-defaults.ly 2006-10-20 18:34:18.000000000 +0200 +++ new-lilypond/ly/paper-defaults.ly 2006-10-20 18:34:18.000000000 +0200 @@ -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 -rN -u old-lilypond/scm/define-grobs.scm new-lilypond/scm/define-grobs.scm --- old-lilypond/scm/define-grobs.scm 2006-10-20 18:34:18.000000000 +0200 +++ new-lilypond/scm/define-grobs.scm 2006-10-20 18:34:18.000000000 +0200 @@ -2031,72 +2031,45 @@ (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-public pure-conversions-alist (list `(,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-public 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))))))))))