From: Han-Wen Nienhuys Date: Fri, 7 Jan 2005 12:23:03 +0000 (+0000) Subject: * lily/output-def-scheme.cc: new file. X-Git-Tag: release/2.5.14~307 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=eea589c2d7bee6ab38bc611eb205d4c74e2011f7;p=lilypond.git * lily/output-def-scheme.cc: new file. * lily/paper-book-scheme.cc: new file. * lily/duration-scheme.cc (LY_DEFINE): new file. * lily/pitch-scheme.cc: new file. --- diff --git a/ChangeLog b/ChangeLog index f6514d398f..2d386908f5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,13 @@ 2005-01-07 Han-Wen Nienhuys + * lily/output-def-scheme.cc: new file. + + * lily/paper-book-scheme.cc: new file. + + * lily/duration-scheme.cc (LY_DEFINE): new file. + + * lily/pitch-scheme.cc: new file. + * scm/font.scm (add-cmr-fonts): use real dimens in font selection. 2005-01-07 Han-Wen Nienhuys diff --git a/lily/context-scheme.cc b/lily/context-scheme.cc index f5a27b82a3..0b7ceef2f4 100644 --- a/lily/context-scheme.cc +++ b/lily/context-scheme.cc @@ -151,3 +151,5 @@ LY_DEFINE (ly_context_find, "ly:context-find", return SCM_BOOL_F; } + + diff --git a/lily/duration-scheme.cc b/lily/duration-scheme.cc new file mode 100644 index 0000000000..a265e50215 --- /dev/null +++ b/lily/duration-scheme.cc @@ -0,0 +1,124 @@ +/* + duration.cc -- implement Duration + + source file of the LilyPond music typesetter + + (c) 1997--2004 Jan Nieuwenhuizen + Han-Wen Nienhuys + +*/ + +#include "duration.hh" +#include "misc.hh" + +MAKE_SCHEME_CALLBACK (Duration, less_p, 2); +SCM +Duration::less_p (SCM p1, SCM p2) +{ + Duration *a = unsmob_duration (p1); + Duration *b = unsmob_duration (p2); + + if (compare (*a, *b) < 0) + return SCM_BOOL_T; + else + return SCM_BOOL_F; +} + +LY_DEFINE (ly_duration_less_p, "ly:durationduration_log ()); +} + +LY_DEFINE (ly_duration_dot_count, "ly:duration-dot-count", + 1, 0, 0, (SCM dur), + "Extract the dot count from @var{dur}") +{ + SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); + return scm_int2num (unsmob_duration (dur)->dot_count ()); +} + +LY_DEFINE (ly_intlog2, "ly:intlog2", + 1, 0, 0, (SCM d), + "The 2-logarithm of 1/@var{d}.") +{ + SCM_ASSERT_TYPE (scm_is_number (d), d, SCM_ARG1, __FUNCTION__, "integer"); + int log = intlog2 (scm_to_int (d)); + return scm_int2num (log); +} + +LY_DEFINE (ly_duration_factor, "ly:duration-factor", + 1, 0, 0, (SCM dur), + "Extract the compression factor from @var{dur}. Return as a pair.") +{ + SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); + Rational r = unsmob_duration (dur)->factor (); + return scm_cons (scm_int2num (r.num ()), scm_int2num (r.den ())); +} diff --git a/lily/duration.cc b/lily/duration.cc index 4a836d5dd8..642d7b250c 100644 --- a/lily/duration.cc +++ b/lily/duration.cc @@ -112,117 +112,6 @@ Duration::equal_p (SCM a , SCM b) return eq ? SCM_BOOL_T : SCM_BOOL_F; } -MAKE_SCHEME_CALLBACK (Duration, less_p, 2); -SCM -Duration::less_p (SCM p1, SCM p2) -{ - Duration *a = unsmob_duration (p1); - Duration *b = unsmob_duration (p2); - - if (compare (*a, *b) < 0) - return SCM_BOOL_T; - else - return SCM_BOOL_F; -} - -LY_DEFINE (ly_duration_less_p, "ly:durationduration_log ()); -} - -LY_DEFINE (ly_duration_dot_count, "ly:duration-dot-count", - 1, 0, 0, (SCM dur), - "Extract the dot count from @var{dur}") -{ - SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); - return scm_int2num (unsmob_duration (dur)->dot_count ()); -} - -LY_DEFINE (ly_intlog2, "ly:intlog2", - 1, 0, 0, (SCM d), - "The 2-logarithm of 1/@var{d}.") -{ - SCM_ASSERT_TYPE (scm_is_number (d), d, SCM_ARG1, __FUNCTION__, "integer"); - int log = intlog2 (scm_to_int (d)); - return scm_int2num (log); -} - -LY_DEFINE (ly_duration_factor, "ly:duration-factor", - 1, 0, 0, (SCM dur), - "Extract the compression factor from @var{dur}. Return as a pair.") -{ - SCM_ASSERT_TYPE (unsmob_duration (dur), dur, SCM_ARG1, __FUNCTION__, "duration"); - Rational r = unsmob_duration (dur)->factor (); - return scm_cons (scm_int2num (r.num ()), scm_int2num (r.den ())); -} int Duration::duration_log () const diff --git a/lily/font-metric-scheme.cc b/lily/font-metric-scheme.cc new file mode 100644 index 0000000000..8ccb94dbc7 --- /dev/null +++ b/lily/font-metric-scheme.cc @@ -0,0 +1,144 @@ +/* + font-metric-scheme.cc -- implement Font_metric scheme bindings + + source file of the GNU LilyPond music typesetter + + (c) 2005 Han-Wen Nienhuys + +*/ + +#include "stencil.hh" +#include "font-metric.hh" +#include "modified-font-metric.hh" + +LY_DEFINE (ly_font_get_glyph, "ly:font-get-glyph", + 2, 0, 0, + (SCM font, SCM name), + "Return a Stencil from @var{font} for the glyph named @var{name}. " + "@var{font} must be available as an AFM file. If the glyph " + "is not available, return @code{#f}.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG2, __FUNCTION__, "string"); + + Stencil m = fm->find_by_name (ly_scm2string (name)); + + /* TODO: make optional argument for default if not found. */ + return m.smobbed_copy (); +} + +LY_DEFINE (ly_get_glyph, "ly:get-glyph", + 2, 0, 0, + (SCM font, SCM index), + "Retrieve a Stencil for the glyph numbered @var{index} " + "in @var{font}.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + SCM_ASSERT_TYPE (scm_is_number (index), index, SCM_ARG2, __FUNCTION__, "number"); + + return fm->get_ascii_char_stencil (scm_to_int (index)).smobbed_copy (); +} + +LY_DEFINE (ly_font_glyph_name_to_index, "ly:font-glyph-name-to-index", + 2, 0, 0, + (SCM font, SCM name), + "Return the index for @var{name} in @var{font}.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG2, __FUNCTION__, "string"); + + return scm_from_int (fm->name_to_index (ly_scm2string (name))); +} + +LY_DEFINE (ly_font_index_to_charcode, "ly:font-index-to-charcode", + 2, 0, 0, + (SCM font, SCM index), + "Return the character code for @var{index} @var{font}.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + SCM_ASSERT_TYPE (scm_is_integer (index), index, SCM_ARG2, __FUNCTION__, "index"); + + return scm_from_unsigned_integer (fm->index_to_charcode (scm_to_int (index))); +} + +LY_DEFINE (ly_font_glyph_name_to_charcode, "ly:font-glyph-name-to-charcode", + 2, 0, 0, + (SCM font, SCM name), + "Return the character code for glyph @var{name} in @var{font}.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG2, __FUNCTION__, "string"); +#if 1 + return scm_from_unsigned_integer (fm->index_to_charcode (fm->name_to_index (ly_scm2string (name)))); +#else + return scm_from_unsigned_integer (fm->glyph_name_to_charcode (ly_scm2string (name))); +#endif +} + +LY_DEFINE (ly_text_dimension, "ly:text-dimension", + 2, 0, 0, + (SCM font, SCM text), + "Given the font metric in @var{font} and the string @var{text}, " + "compute the extents of that text in that font. " + "The return value is a pair of number-pairs.") +{ + Box b; + Modified_font_metric*fm = dynamic_cast + (unsmob_metrics (font)); + + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "modified font metric"); + SCM_ASSERT_TYPE (scm_is_string (text), text, SCM_ARG2, __FUNCTION__, "string"); + Stencil stc (fm->text_stencil (ly_scm2string (text))); + return scm_cons (ly_interval2scm (stc.extent (X_AXIS)), + ly_interval2scm (stc.extent (Y_AXIS))); +} + +LY_DEFINE (ly_font_file_name, "ly:font-file-name", + 1, 0, 0, + (SCM font), + "Given the font metric @var{font}, " + "return the corresponding file name.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + return fm->font_file_name(); +} + + +LY_DEFINE (ly_font_name, "ly:font-name", + 1, 0, 0, + (SCM font), + "Given the font metric @var{font}, " + "return the corresponding name.") +{ + Font_metric *fm = unsmob_metrics (font); + + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + return scm_makfrom0str (fm->font_name().to_str0 ()); +} + +LY_DEFINE (ly_font_magnification, "ly:font-magnification", 1, 0, 0, + (SCM font), + "Given the font metric @var{font}, return the " + "magnification, relative to the current outputscale.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + return scm_cdr (fm->description_); +} + +LY_DEFINE (ly_font_design_size, "ly:font-design-size", 1, 0, 0, + (SCM font), + "Given the font metric @var{font}, return the " + "design size, relative to the current outputscale.") +{ + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + return scm_make_real (fm->design_size ()); +} + diff --git a/lily/font-metric.cc b/lily/font-metric.cc index 4e7b908537..dd1d6245ca 100644 --- a/lily/font-metric.cc +++ b/lily/font-metric.cc @@ -128,104 +128,6 @@ IMPLEMENT_DEFAULT_EQUAL_P (Font_metric); IMPLEMENT_TYPE_P (Font_metric, "ly:font-metric?"); -LY_DEFINE (ly_font_get_glyph, "ly:font-get-glyph", - 2, 0, 0, - (SCM font, SCM name), - "Return a Stencil from @var{font} for the glyph named @var{name}. " - "@var{font} must be available as an AFM file. If the glyph " - "is not available, return @code{#f}.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG2, __FUNCTION__, "string"); - - Stencil m = fm->find_by_name (ly_scm2string (name)); - - /* TODO: make optional argument for default if not found. */ - return m.smobbed_copy (); -} - -LY_DEFINE (ly_get_glyph, "ly:get-glyph", - 2, 0, 0, - (SCM font, SCM index), - "Retrieve a Stencil for the glyph numbered @var{index} " - "in @var{font}.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - SCM_ASSERT_TYPE (scm_is_number (index), index, SCM_ARG2, __FUNCTION__, "number"); - - return fm->get_ascii_char_stencil (scm_to_int (index)).smobbed_copy (); -} - -LY_DEFINE (ly_font_glyph_name_to_index, "ly:font-glyph-name-to-index", - 2, 0, 0, - (SCM font, SCM name), - "Return the index for @var{name} in @var{font}.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG2, __FUNCTION__, "string"); - - return scm_from_int (fm->name_to_index (ly_scm2string (name))); -} - -LY_DEFINE (ly_font_index_to_charcode, "ly:font-index-to-charcode", - 2, 0, 0, - (SCM font, SCM index), - "Return the character code for @var{index} @var{font}.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - SCM_ASSERT_TYPE (scm_is_integer (index), index, SCM_ARG2, __FUNCTION__, "index"); - - return scm_from_unsigned_integer (fm->index_to_charcode (scm_to_int (index))); -} - -LY_DEFINE (ly_font_glyph_name_to_charcode, "ly:font-glyph-name-to-charcode", - 2, 0, 0, - (SCM font, SCM name), - "Return the character code for glyph @var{name} in @var{font}.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG2, __FUNCTION__, "string"); -#if 1 - return scm_from_unsigned_integer (fm->index_to_charcode (fm->name_to_index (ly_scm2string (name)))); -#else - return scm_from_unsigned_integer (fm->glyph_name_to_charcode (ly_scm2string (name))); -#endif -} - -LY_DEFINE (ly_text_dimension, "ly:text-dimension", - 2, 0, 0, - (SCM font, SCM text), - "Given the font metric in @var{font} and the string @var{text}, " - "compute the extents of that text in that font. " - "The return value is a pair of number-pairs.") -{ - Box b; - Modified_font_metric*fm = dynamic_cast - (unsmob_metrics (font)); - - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "modified font metric"); - SCM_ASSERT_TYPE (scm_is_string (text), text, SCM_ARG2, __FUNCTION__, "string"); - Stencil stc (fm->text_stencil (ly_scm2string (text))); - return scm_cons (ly_interval2scm (stc.extent (X_AXIS)), - ly_interval2scm (stc.extent (Y_AXIS))); -} - -LY_DEFINE (ly_font_file_name, "ly:font-file-name", - 1, 0, 0, - (SCM font), - "Given the font metric @var{font}, " - "return the corresponding file name.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - return fm->font_file_name(); -} - SCM Font_metric::font_file_name () const { @@ -241,39 +143,6 @@ Font_metric::font_name () const #include "afm.hh" -LY_DEFINE (ly_font_name, "ly:font-name", - 1, 0, 0, - (SCM font), - "Given the font metric @var{font}, " - "return the corresponding name.") -{ - Font_metric *fm = unsmob_metrics (font); - - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - return scm_makfrom0str (fm->font_name().to_str0 ()); -} - -LY_DEFINE (ly_font_magnification, "ly:font-magnification", 1, 0, 0, - (SCM font), - "Given the font metric @var{font}, return the " - "magnification, relative to the current outputscale.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - return scm_cdr (fm->description_); -} - -LY_DEFINE (ly_font_design_size, "ly:font-design-size", 1, 0, 0, - (SCM font), - "Given the font metric @var{font}, return the " - "design size, relative to the current outputscale.") -{ - Font_metric *fm = unsmob_metrics (font); - SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); - return scm_make_real (fm->design_size ()); -} - - int Font_metric::index_to_ascii (int i) const @@ -334,3 +203,4 @@ Font_metric::text_dimension (String) const { return Box (Interval (0,0), Interval (0,0)); } + diff --git a/lily/include/global-context.hh b/lily/include/global-context.hh index 1a779a7eac..166e81d9b2 100644 --- a/lily/include/global-context.hh +++ b/lily/include/global-context.hh @@ -46,6 +46,6 @@ protected: Moment now_mom_; }; - +SCM ly_format_output (SCM, SCM); #endif // GLOBAL_CONTEXT_HH diff --git a/lily/moment-scheme.cc b/lily/moment-scheme.cc new file mode 100644 index 0000000000..018ace20b2 --- /dev/null +++ b/lily/moment-scheme.cc @@ -0,0 +1,109 @@ +/* + moment.cc -- implement Moment bindings + + source file of the GNU LilyPond music typesetter + + (c) 1999--2004 Han-Wen Nienhuys +*/ + +#include "moment.hh" + + +/* TODO: add optional factor argument. */ +LY_DEFINE (ly_make_moment, "ly:make-moment", + 2, 2, 0, (SCM n, SCM d, SCM gn, SCM gd), + "Create the rational number with main timing @var{n}/@var{d}, " + "and optional grace timin @var{gn}/@var{gd}.\n" + "\n" + "\n" + "Moment is a point in musical time. " + "It is consists of a pair of rationals (@var{m},@var{g}), " + "where @var{m} is the timing for the main\n" + "notes, and @var{g} the timing for grace notes. " + "In absence of grace notes, @var{g} is zero.\n") +{ + SCM_ASSERT_TYPE (scm_is_integer (n), n, SCM_ARG1, __FUNCTION__, "integer"); + SCM_ASSERT_TYPE (scm_is_integer (d), d, SCM_ARG2, __FUNCTION__, "integer"); + + int grace_num = 0; + if (gn != SCM_UNDEFINED) + { + SCM_ASSERT_TYPE (scm_is_integer (gn), gn, SCM_ARG3, __FUNCTION__, "integer"); + grace_num = scm_to_int (gn); + } + + int grace_den = 1; + if (gd != SCM_UNDEFINED) + { + SCM_ASSERT_TYPE (scm_is_integer (gd), gd, SCM_ARG4, __FUNCTION__, "integer"); + grace_den = scm_to_int (gd); + } + + return Moment (Rational (scm_to_int (n), scm_to_int (d)), + Rational (grace_num, grace_den)).smobbed_copy (); +} + +LY_DEFINE (ly_add_moment, "ly:add-moment", + 2, 0, 0, (SCM a, SCM b), + "Add two moments.") +{ + Moment *ma = unsmob_moment (a); + Moment *mb = unsmob_moment (b); + SCM_ASSERT_TYPE (ma, a, SCM_ARG1, __FUNCTION__, "moment"); + SCM_ASSERT_TYPE (mb, b, SCM_ARG2, __FUNCTION__, "moment"); + return (*ma + *mb).smobbed_copy (); +} + +LY_DEFINE (ly_mul_moment,"ly:mul-moment", + 2, 0, 0, (SCM a, SCM b), + "Multiply two moments.") +{ + Moment *ma = unsmob_moment (a); + Moment *mb = unsmob_moment (b); + SCM_ASSERT_TYPE (ma, a, SCM_ARG1, __FUNCTION__, "moment"); + SCM_ASSERT_TYPE (mb, b, SCM_ARG2, __FUNCTION__, "moment"); + return (*ma * *mb).smobbed_copy (); +} + +LY_DEFINE (ly_div_moment,"ly:div-moment", + 2, 0, 0, (SCM a, SCM b), + "Divide two moments.") +{ + Moment *ma = unsmob_moment (a); + Moment *mb = unsmob_moment (b); + SCM_ASSERT_TYPE (ma, a, SCM_ARG1, __FUNCTION__, "moment"); + SCM_ASSERT_TYPE (mb, b, SCM_ARG2, __FUNCTION__, "moment"); + return (*ma / *mb).smobbed_copy (); +} + +LY_DEFINE (ly_moment_main_numerator,"ly:moment-main-numerator", + 1, 0, 0, (SCM mom), + "Extract numerator from main timing.") +{ + Moment *ma = unsmob_moment (mom); + SCM_ASSERT_TYPE (ma, mom, SCM_ARG1, __FUNCTION__, "moment"); + + return scm_from_int (ma->main_part_.numerator ()); +} + +LY_DEFINE (ly_moment_main_denominator,"ly:moment-main-denominator", + 1, 0, 0, (SCM mom), + "Extract denominator from main timing.") +{ + Moment *ma = unsmob_moment (mom); + SCM_ASSERT_TYPE (ma, mom, SCM_ARG1, __FUNCTION__, "moment"); + + return scm_from_int (ma->main_part_.denominator ()); +} + +LY_DEFINE (ly_moment_less_p,"ly:momentmain_part_.numerator ()); -} - -LY_DEFINE (ly_moment_main_denominator,"ly:moment-main-denominator", - 1, 0, 0, (SCM mom), - "Extract denominator from main timing.") -{ - Moment *ma = unsmob_moment (mom); - SCM_ASSERT_TYPE (ma, mom, SCM_ARG1, __FUNCTION__, "moment"); - - return scm_from_int (ma->main_part_.denominator ()); -} - -LY_DEFINE (ly_moment_less_p,"ly:moment + +*/ + +#include "music.hh" +#include "pitch.hh" + +LY_DEFINE (ly_music_length, "ly:music-length", + 1, 0, 0, (SCM mus), + "Get the length of music expression @var{mus}, and return as a @code{Moment} object.") +{ + Music *sc = unsmob_music (mus); + SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); + return sc->get_length ().smobbed_copy (); +} + +LY_DEFINE (ly_music_property, + "ly:music-property", 2, 0, 0, (SCM mus, SCM sym), + "Get the property @var{sym} of music expression @var{mus}.\n" + "If @var{sym} is undefined, return @code{' ()}.\n" ) +{ + Music * sc = unsmob_music (mus); + SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); + SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); + + return sc->internal_get_property (sym); +} + +LY_DEFINE (ly_music_set_property, "ly:music-set-property!", + 3, 0, 0, (SCM mus, SCM sym, SCM val), + "Set property @var{sym} in music expression @var{mus} to @var{val}.") +{ + Music * sc = unsmob_music (mus); + SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); + SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); + + bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?")); + if (ok) + { + sc->internal_set_property (sym, val); + } + + return SCM_UNSPECIFIED; +} + +LY_DEFINE (ly_music_name, "ly:music-name", + 1, 0, 0, (SCM mus), + "Return the name of @var{music}.") +{ + Music *m = unsmob_music (mus); + SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__ ,"music"); + + char const *nm = classname (m); + return scm_makfrom0str (nm); +} + +/* todo: property args */ +LY_DEFINE (ly_extended_make_music, "ly:make-bare-music", + 2, 0, 0, (SCM type, SCM props), + "Make a C++ music object of type @var{type}, initialize with\n" + "@var{props}. \n\n" + "" + "This function is for internal use, and is only called by " + "@code{make-music}, which is the preferred interface " + "for creating music objects. " + ) +{ + SCM_ASSERT_TYPE (scm_is_string (type), type, SCM_ARG1, __FUNCTION__, "string"); + SCM s = make_music (ly_scm2string (type))->self_scm (); + unsmob_music (s)->immutable_property_alist_ = props; + scm_gc_unprotect_object (s); + return s; +} + +/* todo: property args */ +LY_DEFINE (ly_music_mutable_properties, "ly:music-mutable-properties", + 1, 0, 0, (SCM mus), + "Return an alist containing the mutable properties of @var{mus}.\n" + "The immutable properties are not available, since " + "they are constant and initialized by the " + "@code{make-music} function.\n") +{ + Music *m = unsmob_music (mus); + SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "music"); + return m->get_property_alist (true); +} + +LY_DEFINE (ly_music_list_p,"ly:music-list?", + 1, 0, 0, (SCM lst), + "Type predicate: return true if @var{lst} is a list " + "of music objects.") +{ + if (scm_list_p (lst) == SCM_BOOL_T) + while (scm_is_pair (lst)) + { + if (!unsmob_music (scm_car (lst))) + return SCM_BOOL_F; + lst = scm_cdr (lst); + } + + return SCM_BOOL_T; +} + +LY_DEFINE (ly_music_deep_copy, "ly:music-deep-copy", + 1, 0, 0, (SCM m), + "Copy @var{m} and all sub expressions of @var{m}") +{ + SCM copy = m; + if (unsmob_music (m)) + { + copy = unsmob_music (m)->clone ()->self_scm (); + scm_gc_unprotect_object (copy); + } + else if (scm_is_pair (m)) + copy = scm_cons (ly_music_deep_copy (scm_car (m)), + ly_music_deep_copy (scm_cdr (m))); + return copy; +} + +LY_DEFINE (ly_music_transpose, "ly:music-transpose", + 2, 0, 0, (SCM m, SCM p), + "Transpose @var{m} such that central C is mapped to @var{p}. " + "Return @var{m}.") +{ + Music * sc = unsmob_music (m); + Pitch * sp = unsmob_pitch (p); + SCM_ASSERT_TYPE (sc, m, SCM_ARG1, __FUNCTION__, "music"); + SCM_ASSERT_TYPE (sp, p, SCM_ARG2, __FUNCTION__, "pitch"); + + sc->transpose (*sp); + // SCM_UNDEFINED ? + return sc->self_scm (); +} + +/* + TODO: should take moment factor? + */ +LY_DEFINE (ly_music_compress, "ly:music-compress", + 2, 0, 0, (SCM m, SCM factor), + "Compress music object @var{m} by moment @var{factor}." + ) +{ + Music * sc = unsmob_music (m); + + SCM_ASSERT_TYPE (sc, m, SCM_ARG1, __FUNCTION__, "music"); + SCM_ASSERT_TYPE (unsmob_moment (factor), factor, SCM_ARG2, __FUNCTION__, "moment"); + + sc->compress (*unsmob_moment (factor)); + return sc->self_scm (); +} + diff --git a/lily/music.cc b/lily/music.cc index ca9f2c028a..5889b8e46e 100644 --- a/lily/music.cc +++ b/lily/music.cc @@ -252,163 +252,3 @@ make_music_by_name (SCM sym) scm_gc_protect_object (rv); return unsmob_music (rv); } - -LY_DEFINE (ly_music_length, "ly:music-length", - 1, 0, 0, (SCM mus), - "Get the length of music expression @var{mus}, and return as a @code{Moment} object.") -{ - Music *sc = unsmob_music (mus); - SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); - return sc->get_length ().smobbed_copy (); -} - -LY_DEFINE (ly_music_property, - "ly:music-property", 2, 0, 0, (SCM mus, SCM sym), - "Get the property @var{sym} of music expression @var{mus}.\n" - "If @var{sym} is undefined, return @code{' ()}.\n" ) -{ - Music * sc = unsmob_music (mus); - SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); - SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); - - return sc->internal_get_property (sym); -} - -LY_DEFINE (ly_music_set_property, "ly:music-set-property!", - 3, 0, 0, (SCM mus, SCM sym, SCM val), - "Set property @var{sym} in music expression @var{mus} to @var{val}.") -{ - Music * sc = unsmob_music (mus); - SCM_ASSERT_TYPE (sc, mus, SCM_ARG1, __FUNCTION__, "music"); - SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); - - bool ok = type_check_assignment (sym, val, ly_symbol2scm ("music-type?")); - if (ok) - { - sc->internal_set_property (sym, val); - } - - return SCM_UNSPECIFIED; -} - -LY_DEFINE (ly_music_name, "ly:music-name", - 1, 0, 0, (SCM mus), - "Return the name of @var{music}.") -{ - Music *m = unsmob_music (mus); - SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__ ,"music"); - - char const *nm = classname (m); - return scm_makfrom0str (nm); -} - -/* todo: property args */ -LY_DEFINE (ly_extended_make_music, "ly:make-bare-music", - 2, 0, 0, (SCM type, SCM props), - "Make a C++ music object of type @var{type}, initialize with\n" - "@var{props}. \n\n" - "" - "This function is for internal use, and is only called by " - "@code{make-music}, which is the preferred interface " - "for creating music objects. " - ) -{ - SCM_ASSERT_TYPE (scm_is_string (type), type, SCM_ARG1, __FUNCTION__, "string"); - SCM s = make_music (ly_scm2string (type))->self_scm (); - unsmob_music (s)->immutable_property_alist_ = props; - scm_gc_unprotect_object (s); - return s; -} - -/* todo: property args */ -LY_DEFINE (ly_music_mutable_properties, "ly:music-mutable-properties", - 1, 0, 0, (SCM mus), - "Return an alist containing the mutable properties of @var{mus}.\n" - "The immutable properties are not available, since " - "they are constant and initialized by the " - "@code{make-music} function.\n") -{ - Music *m = unsmob_music (mus); - SCM_ASSERT_TYPE (m, mus, SCM_ARG1, __FUNCTION__, "music"); - return m->get_property_alist (true); -} - -LY_DEFINE (ly_music_list_p,"ly:music-list?", - 1, 0, 0, (SCM lst), - "Type predicate: return true if @var{lst} is a list " - "of music objects.") -{ - if (scm_list_p (lst) == SCM_BOOL_T) - while (scm_is_pair (lst)) - { - if (!unsmob_music (scm_car (lst))) - return SCM_BOOL_F; - lst = scm_cdr (lst); - } - - return SCM_BOOL_T; -} - -LY_DEFINE (ly_music_deep_copy, "ly:music-deep-copy", - 1, 0, 0, (SCM m), - "Copy @var{m} and all sub expressions of @var{m}") -{ - SCM copy = m; - if (unsmob_music (m)) - { - copy = unsmob_music (m)->clone ()->self_scm (); - scm_gc_unprotect_object (copy); - } - else if (scm_is_pair (m)) - copy = scm_cons (ly_music_deep_copy (scm_car (m)), - ly_music_deep_copy (scm_cdr (m))); - return copy; -} - -LY_DEFINE (ly_music_transpose, "ly:music-transpose", - 2, 0, 0, (SCM m, SCM p), - "Transpose @var{m} such that central C is mapped to @var{p}. " - "Return @var{m}.") -{ - Music * sc = unsmob_music (m); - Pitch * sp = unsmob_pitch (p); - SCM_ASSERT_TYPE (sc, m, SCM_ARG1, __FUNCTION__, "music"); - SCM_ASSERT_TYPE (sp, p, SCM_ARG2, __FUNCTION__, "pitch"); - - sc->transpose (*sp); - // SCM_UNDEFINED ? - return sc->self_scm (); -} - -/* - TODO: should take moment factor? - */ -LY_DEFINE (ly_music_compress, "ly:music-compress", - 2, 0, 0, (SCM m, SCM factor), - "Compress music object @var{m} by moment @var{factor}." - ) -{ - Music * sc = unsmob_music (m); - - SCM_ASSERT_TYPE (sc, m, SCM_ARG1, __FUNCTION__, "music"); - SCM_ASSERT_TYPE (unsmob_moment (factor), factor, SCM_ARG2, __FUNCTION__, "moment"); - - sc->compress (*unsmob_moment (factor)); - return sc->self_scm (); -} - -LY_DEFINE (ly_music_scorify, "ly:music-scorify", - 2, 0, 0, - (SCM music, SCM parser), - "Return MUSIC encapsulated in SCORE.") -{ -#if 0 - SCM_ASSERT_TYPE (ly_c_music_p (music), music, SCM_ARG1, __FUNCTION__, "music"); -#endif - Score *score = new Score; - - score->set_music (music, parser); - - scm_gc_unprotect_object (score->self_scm ()); - return score->self_scm (); -} diff --git a/lily/output-def-scheme.cc b/lily/output-def-scheme.cc new file mode 100644 index 0000000000..5465ef4075 --- /dev/null +++ b/lily/output-def-scheme.cc @@ -0,0 +1,96 @@ +/* + output-def-scheme.cc -- implement Output_def bindings + + source file of the GNU LilyPond music typesetter + + (c) 2005 Han-Wen Nienhuys + +*/ + +#include "output-def.hh" +#include "ly-module.hh" +#include "context-def.hh" + +LY_DEFINE (ly_layout_lookup, "ly:output-def-lookup", + 2, 0, 0, (SCM pap, SCM sym), + "Lookup @var{sym} in @var{pap}. " + "Return the value or @code{'()} if undefined.") +{ + Output_def *op = unsmob_output_def (pap); + SCM_ASSERT_TYPE (op, pap, SCM_ARG1, __FUNCTION__, "Output_def"); + SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); + + return op->lookup_variable (sym); +} + +LY_DEFINE (ly_output_def_scope, "ly:output-def-scope", + 1, 0, 0, (SCM def), + "Get the variable scope inside @var{def}.") +{ + Output_def *op = unsmob_output_def (def); + SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition"); + return op->scope_; +} + +LY_DEFINE (ly_output_def_parent, "ly:output-def-parent", + 1, 0, 0, (SCM def), + "Get the parent output-def of @var{def}.") +{ + Output_def *op = unsmob_output_def (def); + SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition"); + return op->parent_ ? op->parent_->self_scm () : SCM_EOL; +} + +LY_DEFINE (ly_output_def_clone, "ly:output-def-clone", + 1, 0, 0, (SCM def), + "Clone @var{def}.") +{ + Output_def *op = unsmob_output_def (def); + SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition"); + SCM s = op->clone ()->self_scm (); + scm_gc_unprotect_object (s); + return s; +} + +LY_DEFINE (ly_output_description, "ly:output-description", + 1, 0, 0, (SCM output_def), + "Return the description of translators in @var{output-def}.") +{ + Output_def *id = unsmob_output_def (output_def); + + SCM al = ly_module2alist (id->scope_); + + SCM ell = SCM_EOL; + for (SCM s = al; scm_is_pair (s); s = scm_cdr (s)) + { + Context_def * td = unsmob_context_def (scm_cdar (s)); + SCM key = scm_caar (s); + if (td && key == td->get_context_name ()) + ell = scm_cons (scm_cons (key, td->to_alist ()), ell); + } + return ell; +} + +LY_DEFINE (ly_layout_def_p, "ly:layout-def?", + 1, 0, 0, (SCM def), + "Is @var{def} a layout definition?") +{ + return ly_bool2scm (unsmob_output_def (def)); +} + +LY_DEFINE (ly_paper_outputscale, "ly:paper-outputscale", + 1, 0, 0, (SCM bp), + "Get outputscale for BP.") +{ + Output_def *b = unsmob_output_def (bp); + SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "paper"); + return scm_make_real (output_scale (b)); +} + +LY_DEFINE (ly_make_output_def, "ly:make-output-def", + 0, 0, 0, (), + "Make a output def.") +{ + Output_def *bp = new Output_def ; + return scm_gc_unprotect_object (bp->self_scm ()); +} diff --git a/lily/output-def.cc b/lily/output-def.cc index 404b512807..e4614ffe11 100644 --- a/lily/output-def.cc +++ b/lily/output-def.cc @@ -18,6 +18,8 @@ #include "scm-hash.hh" #include "warn.hh" +#include "ly-smobs.icc" + Output_def::Output_def () { scope_ = SCM_EOL; @@ -43,7 +45,6 @@ Output_def::~Output_def () { } -#include "ly-smobs.icc" IMPLEMENT_SMOBS (Output_def); IMPLEMENT_DEFAULT_EQUAL_P (Output_def); @@ -125,65 +126,6 @@ Output_def::set_variable (SCM sym, SCM val) scm_module_define (scope_, sym, val); } -LY_DEFINE (ly_layout_lookup, "ly:output-def-lookup", - 2, 0, 0, (SCM pap, SCM sym), - "Lookup @var{sym} in @var{pap}. " - "Return the value or @code{'()} if undefined.") -{ - Output_def *op = unsmob_output_def (pap); - SCM_ASSERT_TYPE (op, pap, SCM_ARG1, __FUNCTION__, "Output_def"); - SCM_ASSERT_TYPE (scm_is_symbol (sym), sym, SCM_ARG2, __FUNCTION__, "symbol"); - - return op->lookup_variable (sym); -} - -LY_DEFINE (ly_output_def_scope, "ly:output-def-scope", - 1, 0, 0, (SCM def), - "Get the variable scope inside @var{def}.") -{ - Output_def *op = unsmob_output_def (def); - SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition"); - return op->scope_; -} - -LY_DEFINE (ly_output_def_parent, "ly:output-def-parent", - 1, 0, 0, (SCM def), - "Get the parent output-def of @var{def}.") -{ - Output_def *op = unsmob_output_def (def); - SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition"); - return op->parent_ ? op->parent_->self_scm () : SCM_EOL; -} - -LY_DEFINE (ly_output_def_clone, "ly:output-def-clone", - 1, 0, 0, (SCM def), - "Clone @var{def}.") -{ - Output_def *op = unsmob_output_def (def); - SCM_ASSERT_TYPE (op, def, SCM_ARG1, __FUNCTION__, "Output definition"); - SCM s = op->clone ()->self_scm (); - scm_gc_unprotect_object (s); - return s; -} - -LY_DEFINE (ly_output_description, "ly:output-description", - 1, 0, 0, (SCM output_def), - "Return the description of translators in @var{output-def}.") -{ - Output_def *id = unsmob_output_def (output_def); - - SCM al = ly_module2alist (id->scope_); - - SCM ell = SCM_EOL; - for (SCM s = al; scm_is_pair (s); s = scm_cdr (s)) - { - Context_def * td = unsmob_context_def (scm_cdar (s)); - SCM key = scm_caar (s); - if (td && key == td->get_context_name ()) - ell = scm_cons (scm_cons (key, td->to_alist ()), ell); - } - return ell; -} /* FIXME. This is broken until we have a generic way of putting lists inside the \layout block. */ @@ -195,28 +137,4 @@ line_dimensions_int (Output_def *def, int n) return Interval (ind, lw); } -LY_DEFINE (ly_layout_def_p, "ly:layout-def?", - 1, 0, 0, (SCM def), - "Is @var{def} a layout definition?") -{ - return ly_bool2scm (unsmob_output_def (def)); -} - -LY_DEFINE (ly_paper_outputscale, "ly:paper-outputscale", - 1, 0, 0, (SCM bp), - "Get outputscale for BP.") -{ - Output_def *b = unsmob_output_def (bp); - SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "paper"); - return scm_make_real (output_scale (b)); -} - -LY_DEFINE (ly_make_output_def, "ly:make-output-def", - 0, 0, 0, (), - "Make a output def.") -{ - Output_def *bp = new Output_def ; - return scm_gc_unprotect_object (bp->self_scm ()); -} - diff --git a/lily/pango-font.cc b/lily/pango-font.cc index dbd41e443b..45da3a6e30 100644 --- a/lily/pango-font.cc +++ b/lily/pango-font.cc @@ -36,6 +36,7 @@ Pango_font::Pango_font (PangoFT2FontMap *fontmap, // context_ = pango_ft2_font_map_create_context (fontmap); attribute_list_= pango_attr_list_new(); + /* urgh. I don't understand this. Why isn't this 1/(scale * resolution) diff --git a/lily/paper-book-scheme.cc b/lily/paper-book-scheme.cc new file mode 100644 index 0000000000..37cf9874e4 --- /dev/null +++ b/lily/paper-book-scheme.cc @@ -0,0 +1,47 @@ +/* + paper-book-scheme.cc -- implement Paper_book bindings + + source file of the GNU LilyPond music typesetter + + (c) 2005 Han-Wen Nienhuys + +*/ + +#include "paper-book.hh" +#include "ly-module.hh" +#include "output-def.hh" + +LY_DEFINE (ly_paper_book_pages, "ly:paper-book-pages", + 1, 0, 0, (SCM pb), + "Return pages in book PB.") +{ + return unsmob_paper_book(pb)->pages (); +} + +LY_DEFINE (ly_paper_book_scopes, "ly:paper-book-scopes", + 1, 0, 0, (SCM book), + "Return pages in layout book @var{book}.") +{ + Paper_book *pb = unsmob_paper_book(book); + SCM_ASSERT_TYPE(pb, book, SCM_ARG1, __FUNCTION__, "Paper_book"); + + SCM scopes = SCM_EOL; + if (ly_c_module_p (pb->header_)) + scopes = scm_cons (pb->header_, scopes); + + return scopes; +} + +LY_DEFINE (ly_paper_book_systems, "ly:paper-book-systems", + 1, 0, 0, (SCM pb), + "Return systems in book PB.") +{ + return unsmob_paper_book (pb)->systems (); +} + +LY_DEFINE (ly_paper_book_paper, "ly:paper-book-paper", + 1, 0, 0, (SCM pb), + "Return pages in book PB.") +{ + return unsmob_paper_book (pb)->paper_->self_scm (); +} diff --git a/lily/paper-book.cc b/lily/paper-book.cc index e6d63aa0cb..352ee06f08 100644 --- a/lily/paper-book.cc +++ b/lily/paper-book.cc @@ -147,40 +147,6 @@ Paper_book::classic_output (String outname) progress_indication ("\n"); } -LY_DEFINE (ly_paper_book_pages, "ly:paper-book-pages", - 1, 0, 0, (SCM pb), - "Return pages in book PB.") -{ - return unsmob_paper_book(pb)->pages (); -} - -LY_DEFINE (ly_paper_book_scopes, "ly:paper-book-scopes", - 1, 0, 0, (SCM book), - "Return pages in layout book @var{book}.") -{ - Paper_book *pb = unsmob_paper_book(book); - SCM_ASSERT_TYPE(pb, book, SCM_ARG1, __FUNCTION__, "Paper_book"); - - SCM scopes = SCM_EOL; - if (ly_c_module_p (pb->header_)) - scopes = scm_cons (pb->header_, scopes); - - return scopes; -} - -LY_DEFINE (ly_paper_book_systems, "ly:paper-book-systems", - 1, 0, 0, (SCM pb), - "Return systems in book PB.") -{ - return unsmob_paper_book (pb)->systems (); -} - -LY_DEFINE (ly_paper_book_paper, "ly:paper-book-paper", - 1, 0, 0, (SCM pb), - "Return pages in book PB.") -{ - return unsmob_paper_book (pb)->paper_->self_scm (); -} /* TODO: resurrect more complex user-tweaks for titling? */ Stencil diff --git a/lily/pitch-scheme.cc b/lily/pitch-scheme.cc new file mode 100644 index 0000000000..934118c0a8 --- /dev/null +++ b/lily/pitch-scheme.cc @@ -0,0 +1,129 @@ +/* + pitch-scheme.cc -- implement scheme functions for Pitch + + source file of the GNU LilyPond music typesetter + + (c) 2005 Han-Wen Nienhuys + +*/ + +#include "pitch.hh" + +LY_DEFINE (ly_pitch_transpose, "ly:pitch-transpose", + 2, 0, 0, (SCM p, SCM delta), + "Transpose @var{p} by the amount @var{delta}, " + "where @var{delta} is relative to middle C.") +{ + Pitch* t = unsmob_pitch (p); + Pitch *d = unsmob_pitch (delta); + SCM_ASSERT_TYPE (t, p, SCM_ARG1, __FUNCTION__, "pitch"); + SCM_ASSERT_TYPE (d, delta, SCM_ARG1, __FUNCTION__, "pitch"); + return t->transposed (*d).smobbed_copy (); +} + +/* Should add optional args. */ +LY_DEFINE (ly_make_pitch, "ly:make-pitch", + 3, 0, 0, (SCM octave, SCM note, SCM alter), + "@var{octave} is specified by an integer, " + "zero for the octave containing middle C. " + "@var{note} is a number from 0 to 6, " + "with 0 corresponding to C and 6 corresponding to B. " + "The @var{alter} is zero for a natural, negative for " + "flats, or positive for sharps. ") +{ + SCM_ASSERT_TYPE (scm_integer_p (octave)== SCM_BOOL_T , octave, SCM_ARG1, __FUNCTION__, "integer"); + SCM_ASSERT_TYPE (scm_integer_p (note)== SCM_BOOL_T, note, SCM_ARG2, __FUNCTION__, "integer"); + SCM_ASSERT_TYPE (scm_integer_p (alter)== SCM_BOOL_T, alter, SCM_ARG3, __FUNCTION__, "integer"); + + Pitch p (scm_to_int (octave), scm_to_int (note), scm_to_int (alter)); + return p.smobbed_copy (); +} + +LY_DEFINE (ly_pitch_steps, "ly:pitch-steps", 1, 0, 0, + (SCM p), + "Number of steps counted from middle C of the pitch @var{p}.") +{ + Pitch *pp = unsmob_pitch (p); + SCM_ASSERT_TYPE (pp, p, SCM_ARG1, __FUNCTION__, "Pitch"); + return scm_int2num (pp->steps ()); +} + +LY_DEFINE (ly_pitch_octave, "ly:pitch-octave", + 1, 0, 0, (SCM pp), + "Extract the octave from pitch @var{p}.") +{ + Pitch *p = unsmob_pitch (pp); + SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); + int q = p->get_octave (); + return scm_int2num (q); +} + +LY_DEFINE (ly_pitch_alteration, "ly:pitch-alteration", + 1, 0, 0, (SCM pp), + "Extract the alteration from pitch @var{p}.") +{ + Pitch *p = unsmob_pitch (pp); + SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); + int q = p->get_alteration (); + + return scm_int2num (q); +} + +LY_DEFINE (pitch_notename, "ly:pitch-notename", + 1, 0, 0, (SCM pp), + "Extract the note name from pitch @var{pp}.") +{ + Pitch *p = unsmob_pitch (pp); + SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); + int q = p->get_notename (); + return scm_int2num (q); +} + +LY_DEFINE (ly_pitch_quartertones, "ly:pitch-quartertones", + 1, 0, 0, (SCM pp), + "Calculate the number of quarter tones of @var{p} from middle C.") +{ + Pitch *p = unsmob_pitch (pp); + SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); + int q = p->quartertone_pitch (); + return scm_int2num (q); +} + +LY_DEFINE (ly_pitch_semitones, "ly:pitch-semitones", + 1, 0, 0, (SCM pp), + "calculate the number of semitones of @var{p} from middle C.") +{ + Pitch *p = unsmob_pitch (pp); + SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); + int q = p->semitone_pitch (); + return scm_int2num (q); +} + +LY_DEFINE (ly_pitch_less_p, "ly:pitchtransposed (*d).smobbed_copy (); -} - IMPLEMENT_TYPE_P (Pitch, "ly:pitch?"); SCM @@ -278,6 +265,7 @@ Pitch::equal_p (SCM a , SCM b) return eq ? SCM_BOOL_T : SCM_BOOL_F; } + MAKE_SCHEME_CALLBACK (Pitch, less_p, 2); SCM Pitch::less_p (SCM p1, SCM p2) @@ -291,112 +279,6 @@ Pitch::less_p (SCM p1, SCM p2) return SCM_BOOL_F; } -/* Should add optional args. */ -LY_DEFINE (ly_make_pitch, "ly:make-pitch", - 3, 0, 0, (SCM octave, SCM note, SCM alter), - "@var{octave} is specified by an integer, " - "zero for the octave containing middle C. " - "@var{note} is a number from 0 to 6, " - "with 0 corresponding to C and 6 corresponding to B. " - "The @var{alter} is zero for a natural, negative for " - "flats, or positive for sharps. ") -{ - SCM_ASSERT_TYPE (scm_integer_p (octave)== SCM_BOOL_T , octave, SCM_ARG1, __FUNCTION__, "integer"); - SCM_ASSERT_TYPE (scm_integer_p (note)== SCM_BOOL_T, note, SCM_ARG2, __FUNCTION__, "integer"); - SCM_ASSERT_TYPE (scm_integer_p (alter)== SCM_BOOL_T, alter, SCM_ARG3, __FUNCTION__, "integer"); - - Pitch p (scm_to_int (octave), scm_to_int (note), scm_to_int (alter)); - return p.smobbed_copy (); -} - -LY_DEFINE (ly_pitch_steps, "ly:pitch-steps", 1, 0, 0, - (SCM p), - "Number of steps counted from middle C of the pitch @var{p}.") -{ - Pitch *pp = unsmob_pitch (p); - SCM_ASSERT_TYPE (pp, p, SCM_ARG1, __FUNCTION__, "Pitch"); - return scm_int2num (pp->steps ()); -} - -LY_DEFINE (ly_pitch_octave, "ly:pitch-octave", - 1, 0, 0, (SCM pp), - "Extract the octave from pitch @var{p}.") -{ - Pitch *p = unsmob_pitch (pp); - SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); - int q = p->get_octave (); - return scm_int2num (q); -} - -LY_DEFINE (ly_pitch_alteration, "ly:pitch-alteration", - 1, 0, 0, (SCM pp), - "Extract the alteration from pitch @var{p}.") -{ - Pitch *p = unsmob_pitch (pp); - SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); - int q = p->get_alteration (); - - return scm_int2num (q); -} - -LY_DEFINE (pitch_notename, "ly:pitch-notename", - 1, 0, 0, (SCM pp), - "Extract the note name from pitch @var{pp}.") -{ - Pitch *p = unsmob_pitch (pp); - SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); - int q = p->get_notename (); - return scm_int2num (q); -} - -LY_DEFINE (ly_pitch_quartertones, "ly:pitch-quartertones", - 1, 0, 0, (SCM pp), - "Calculate the number of quarter tones of @var{p} from middle C.") -{ - Pitch *p = unsmob_pitch (pp); - SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); - int q = p->quartertone_pitch (); - return scm_int2num (q); -} - -LY_DEFINE (ly_pitch_semitones, "ly:pitch-semitones", - 1, 0, 0, (SCM pp), - "calculate the number of semitones of @var{p} from middle C.") -{ - Pitch *p = unsmob_pitch (pp); - SCM_ASSERT_TYPE (p, pp, SCM_ARG1, __FUNCTION__, "Pitch"); - int q = p->semitone_pitch (); - return scm_int2num (q); -} - -LY_DEFINE (ly_pitch_less_p, "ly:pitch + +*/ + + +#include "score.hh" +#include "music.hh" + +LY_DEFINE (ly_music_scorify, "ly:music-scorify", + 2, 0, 0, + (SCM music, SCM parser), + "Return MUSIC encapsulated in SCORE.") +{ +#if 0 + SCM_ASSERT_TYPE (ly_c_music_p (music), music, SCM_ARG1, __FUNCTION__, "music"); +#endif + Score *score = new Score; + + score->set_music (music, parser); + + scm_gc_unprotect_object (score->self_scm ()); + return score->self_scm (); +} diff --git a/lily/score.cc b/lily/score.cc index 945b7c75e0..99327e36b2 100644 --- a/lily/score.cc +++ b/lily/score.cc @@ -93,81 +93,6 @@ Score::Score (Score const &s) } -LY_DEFINE (ly_run_translator, "ly:run-translator", - 2, 1, 0, (SCM mus, SCM output_def, SCM key), - "Process @var{mus} according to @var{output_def}. \n" - "An interpretation context is set up,\n" - "and @var{mus} is interpreted with it. \n" - "The context is returned in its final state.\n" - - "\n\nOptionally, this routine takes an Object-key to\n" - "to uniquely identify the Score block containing it.\n") -{ - Output_def *odef = unsmob_output_def (output_def); - Music *music = unsmob_music (mus); - - if (!music - || !music->get_length ().to_bool ()) - { - warning (_ ("Need music in a score")); - return SCM_BOOL_F; - } - - SCM_ASSERT_TYPE (music, mus, SCM_ARG1, - __FUNCTION__, "Music"); - SCM_ASSERT_TYPE (odef, output_def, SCM_ARG2, __FUNCTION__, - "Output definition"); - - Cpu_timer timer; - - Global_context *trans = new Global_context (odef, music->get_length (), unsmob_key (key) ); - if (!trans) - { - programming_error ("no toplevel translator"); - return SCM_BOOL_F; - } - - progress_indication (_ ("Interpreting music... ")); - - SCM protected_iter = Music_iterator::get_static_get_iterator (music); - Music_iterator * iter = unsmob_iterator (protected_iter); - iter->init_translator (music, trans); - - iter->construct_children (); - - if (!iter->ok ()) - { - warning (_ ("Need music in a score")); - /* todo: should throw exception. */ - return SCM_BOOL_F; - } - - trans->run_iterator_on_me (iter); - iter->quit (); - scm_remember_upto_here_1 (protected_iter); - trans->finish (); - - if (verbose_global_b) - progress_indication (_f ("elapsed time: %.2f seconds", timer.read ())); - - return scm_gc_unprotect_object (trans->self_scm ()); -} - -LY_DEFINE (ly_format_output, "ly:format-output", - 2, 0, 0, (SCM context, SCM outname), - "Given a Score context in its final state," - "process it and return the (rendered) result.") -{ - Global_context *g = dynamic_cast (unsmob_context (context)); - SCM_ASSERT_TYPE (g, context, SCM_ARG1, __FUNCTION__, "Global context"); - SCM_ASSERT_TYPE (scm_is_string (outname), outname, SCM_ARG2, __FUNCTION__, "output file name"); - - Music_output *output = g->get_output (); - progress_indication ("\n"); - /* ugh, midi still wants outname */ - return output->process (ly_scm2string (outname)); -} - void default_rendering (SCM music, SCM outdef, SCM book_outputdef,