+2006-10-24 Joe Neeman <joeneeman@gmail.com>
+
+ * 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 <mabe@drongo.s3.kth.se>
* Documentation/user/advanced-notation.itely (Instrument names):
Data may be nonnumber. In that case, it is assumed to be
undefined.
*/
-
+
data = SCM_UNDEFINED;
SCM expr = scm_list_2 (proc, data);
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)
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)));
+}
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;
}
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);
}
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");
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 */
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 */
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);
#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 */
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);
};
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
(c) 2005--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
*/
+#include "simple-closure.hh"
+#include "grob.hh"
#include "lily-guile.hh"
static scm_t_bits simple_closure_tag;
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);
}
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;
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;
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 *)
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
%% settings for the page breaker
%%
blank-last-page-force = 0
- blank-page-force = 10
+ blank-page-force = 2
#(define font-defaults
'((font-encoding . fetaMusic)))
(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)))))))))
projects / lilypond.git / commitdiff