From f5e4959be1a00e70a788f40b6b3fced291a11d54 Mon Sep 17 00:00:00 2001 From: fred Date: Wed, 27 Mar 2002 02:06:14 +0000 Subject: [PATCH] lilypond-1.5.36 --- lily/duration.cc | 3 ++ lily/font-interface.cc | 7 +--- lily/font-metric.cc | 27 +++++---------- lily/include/paper-def.hh | 3 +- lily/lexer.ll | 6 ---- lily/paper-def.cc | 13 ++++++++ lily/parser.yy | 6 ++-- lily/translator-group.cc | 18 ++++------ scm/bass-figure.scm | 69 +++++++++++++++++++++++++-------------- scm/c++.scm | 16 +++++++++ scm/lily.scm | 1 + scm/molecule.scm | 38 +++++++++++++++++++++ 12 files changed, 139 insertions(+), 68 deletions(-) create mode 100644 scm/molecule.scm diff --git a/lily/duration.cc b/lily/duration.cc index d04491af59..c46afab108 100644 --- a/lily/duration.cc +++ b/lily/duration.cc @@ -131,6 +131,9 @@ Duration::less_p (SCM p1, SCM p2) static SCM make_duration (SCM l, SCM d) { + SCM_ASSERT_TYPE(gh_number_p(l), l, SCM_ARG1, __FUNCTION__, "integer"); + SCM_ASSERT_TYPE(gh_number_p(d), d, SCM_ARG2, __FUNCTION__, "integer"); + Duration p (gh_scm2int (l), gh_scm2int (d)); return p.smobbed_copy (); } diff --git a/lily/font-interface.cc b/lily/font-interface.cc index c0f7757823..c5c32c2337 100644 --- a/lily/font-interface.cc +++ b/lily/font-interface.cc @@ -69,12 +69,7 @@ SCM ly_font_interface_get_default_font (SCM grob) { Grob * gr = unsmob_grob (grob); - - if (!gr) - { - warning ("ly_font_interface_get_default_font (): invalid argument"); - return SCM_UNDEFINED; - } + SCM_ASSERT_TYPE(gr, grob, SCM_ARG1, __FUNCTION__, "grob"); return Font_interface::get_default_font (gr)->self_scm (); } diff --git a/lily/font-metric.cc b/lily/font-metric.cc index 577471baa3..84c1cd1045 100644 --- a/lily/font-metric.cc +++ b/lily/font-metric.cc @@ -137,14 +137,11 @@ Font_metric::find_by_name (String) const SCM ly_find_glyph_by_name (SCM font, SCM name) { - if (!unsmob_metrics (font) || !gh_string_p (name)) - { - warning ("ly-find-glyph-by-name: invalid argument."); - Molecule m; - return m.smobbed_copy (); - } + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE(fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + SCM_ASSERT_TYPE(gh_string_p (name), name, SCM_ARG2, __FUNCTION__, "string"); - return unsmob_metrics (font)->find_by_name (ly_scm2string (name)).smobbed_copy (); + return fm->find_by_name (ly_scm2string (name)).smobbed_copy (); } @@ -152,17 +149,11 @@ SCM ly_text_dimension (SCM font, SCM text) { Box b; - - if (!unsmob_metrics (font) || !gh_string_p(text)) - { - warning ("ly-find-glyph-by-name: invalid argument."); - Molecule m; - return m.smobbed_copy (); - } - else - { - b = unsmob_metrics (font)->text_dimension (ly_scm2string (text)); - } + Font_metric *fm = unsmob_metrics (font); + SCM_ASSERT_TYPE(fm, font, SCM_ARG1, __FUNCTION__, "font-metric"); + SCM_ASSERT_TYPE(gh_string_p (text), text, SCM_ARG2, __FUNCTION__, "string"); + + b = fm->text_dimension (ly_scm2string (text)); return gh_cons (ly_interval2scm (b[X_AXIS]), ly_interval2scm(b[Y_AXIS])); } diff --git a/lily/include/paper-def.hh b/lily/include/paper-def.hh index 0ad02d105b..6bc9df23d3 100644 --- a/lily/include/paper-def.hh +++ b/lily/include/paper-def.hh @@ -61,7 +61,8 @@ public: */ Real get_realvar (SCM symbol) const; Real get_var (String id) const; - SCM get_scmvar (String id)const; + SCM get_scmvar (String id)const; + SCM get_scmvar_scm (SCM sym) const; void reinit (); Paper_def (); Paper_def (Paper_def const&); diff --git a/lily/lexer.ll b/lily/lexer.ll index 7bff8df6f4..423e437b20 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -272,12 +272,6 @@ HYPHEN -- _ { return FIGURE_SPACE; } - \] { - return FIGURE_BRACKET_CLOSE; - } - \[ { - return FIGURE_BRACKET_OPEN; - } \> { return FIGURE_CLOSE; } diff --git a/lily/paper-def.cc b/lily/paper-def.cc index 5813786e62..d28375ba91 100644 --- a/lily/paper-def.cc +++ b/lily/paper-def.cc @@ -19,6 +19,12 @@ #include "file-results.hh" // urg? header_global_p #include "paper-outputter.hh" +/* + This is an almost empty thing. The only substantial thing this class + handles, is scaling up and down to real-world dimensions (internally + dimensions are against global staff-space.) + + */ Paper_def::Paper_def () { } @@ -45,6 +51,13 @@ Paper_def::get_scmvar (String s) const return scope_p_->scm_elem (ly_symbol2scm (s.ch_C ())); } + +SCM +Paper_def::get_scmvar_scm (SCM sym) const +{ + return gh_double2scm (get_realvar (sym)); +} + Real Paper_def::get_realvar (SCM s) const { diff --git a/lily/parser.yy b/lily/parser.yy index c7a905166c..3f972dcc01 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -1744,12 +1744,14 @@ bass_figure: br_bass_figure: '[' bass_figure { - unsmob_music ($2)->set_mus_property ("bracket-start", SCM_BOOL_T); + $$ = $2; + unsmob_music ($$)->set_mus_property ("bracket-start", SCM_BOOL_T); } | bass_figure { - + $$ = $1; } | br_bass_figure ']' { + $$ = $1; unsmob_music ($1)->set_mus_property ("bracket-stop", SCM_BOOL_T); } ; diff --git a/lily/translator-group.cc b/lily/translator-group.cc index fe46960c4e..2938b2b7cd 100644 --- a/lily/translator-group.cc +++ b/lily/translator-group.cc @@ -414,25 +414,21 @@ ly_get_trans_property (SCM context, SCM name) { Translator *t = unsmob_translator (context); Translator_group* tr= dynamic_cast (t); - if (!t || !tr) - { - /* programming_error? */ - warning (_ ("ly-get-trans-property: expecting a Translator_group argument")); - return SCM_EOL; - } + SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group"); + SCM_ASSERT_TYPE(gh_symbol_p(name), name, SCM_ARG2, __FUNCTION__, "symbol"); + return tr->internal_get_property (name); } SCM ly_set_trans_property (SCM context, SCM name, SCM val) { - Translator *t = unsmob_translator (context); Translator_group* tr= dynamic_cast (t); - if (tr) - { - tr->internal_set_property (name, val); - } + + SCM_ASSERT_TYPE(tr, context, SCM_ARG1, __FUNCTION__, "Translator group"); + tr->internal_set_property (name, val); + return SCM_UNSPECIFIED; } diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm index 409d582245..63001abca2 100644 --- a/scm/bass-figure.scm +++ b/scm/bass-figure.scm @@ -2,14 +2,6 @@ ;;;; todo: make interfaces as 1st level objects in LilyPond. - -(define (fontify-text font-metric text) - "Set TEXT with font FONT-METRIC, returning a molecule." - (let* ((b (ly-text-dimension font-metric text))) - (ly-make-molecule - (ly-fontify-atom font-metric `(text ,text)) (car b) (cdr b)) - )) - (define (brew-one-figure grob fig-music) "Brew a single column for a music figure" (let* ( @@ -38,27 +30,56 @@ mol)) -(define (stack-molecules axis dir padding mols) - "Stack molecules MOLS in direction AXIS,DIR, using PADDING." - (if (null? mols) - '() - (if (pair? mols) - (ly-combine-molecule-at-edge (car mols) axis dir - (stack-molecules axis dir padding (cdr mols)) - padding - ) - ) - )) (define (brew-bass-figure grob) "Make a molecule for a Figured Bass grob" (let* ( (figs (ly-get-grob-property grob 'causes )) - (fig-mols (map (lambda (x) (brew-one-figure grob x)) figs)) - (fig-mol (stack-molecules 1 -1 0.2 fig-mols)) + (mol (ly-make-molecule '() '(0 . 0) '(0 . 0))) + (padding (ly-get-grob-property grob 'padding)) + (kerning (ly-get-grob-property grob 'kern)) + (thickness (* + (ly-get-paper-variable grob 'stafflinethickness) + (ly-get-grob-property grob 'thickness)) + ) ) - (ly-align-to! fig-mol Y DOWN) - fig-mol - )) + + + (define (brew-complete-figure grob figs mol) + "recursive function: take some stuff from FIGS, and add it to MOL." + (define (end-bracket? fig) + (eq? (ly-get-mus-property fig 'bracket-stop) #t) + ) + + (if (null? figs) + mol + (if (eq? (ly-get-mus-property (car figs) 'bracket-start) #t) + (let* ( + (gather-todo (take-from-list-until figs '() end-bracket?)) + (unbr-mols + (map + (lambda (x) (brew-one-figure grob x)) + (reverse! (car gather-todo) '()))) + (br-mol (bracketify-molecule + (stack-molecules Y UP kerning unbr-mols) + Y thickness (* 2 padding) padding)) + ) + (brew-complete-figure + grob (cdr gather-todo) + (ly-combine-molecule-at-edge mol Y UP br-mol kerning) + ) + ) + (brew-complete-figure + grob (cdr figs) + (ly-combine-molecule-at-edge mol Y UP (brew-one-figure grob (car figs)) + kerning)) + ) + )) + + + (set! mol (brew-complete-figure grob (reverse figs) mol)) + (ly-align-to! mol Y DOWN) + mol + )) diff --git a/scm/c++.scm b/scm/c++.scm index dc1bad45a8..5fea3d145d 100644 --- a/scm/c++.scm +++ b/scm/c++.scm @@ -103,6 +103,22 @@ +(define (take-from-list-until todo gathered crit?) + "return (G, T), where (reverse G) + T = GATHERED + TODO, and the last of G +is the first to satisfy CRIT " + (if (null? todo) + (cons gathered todo) + (if (crit? (car todo)) + (cons (cons (car todo) gathered) (cdr todo)) + (take-from-list-until (cdr todo) (cons (car todo) gathered) crit?) + ) + )) +; test: +; (take-from-list-until '(1 2 3 4 5) '() (lambda (x) (eq? x 3))) +; ((3 2 1) 4 5) + + + ; Make a function that checks score element for being of a specific type. (define (make-type-checker symbol) (lambda (elt) diff --git a/scm/lily.scm b/scm/lily.scm index ba77f59747..530228ed61 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -162,6 +162,7 @@ "pdf.scm" "pdftex.scm" "c++.scm" + "molecule.scm" "bass-figure.scm" "grob-property-description.scm" "context-description.scm" diff --git a/scm/molecule.scm b/scm/molecule.scm new file mode 100644 index 0000000000..85176065ae --- /dev/null +++ b/scm/molecule.scm @@ -0,0 +1,38 @@ + +(define (stack-molecules axis dir padding mols) + "Stack molecules MOLS in direction AXIS,DIR, using PADDING." + (if (null? mols) + '() + (if (pair? mols) + (ly-combine-molecule-at-edge (car mols) axis dir + (stack-molecules axis dir padding (cdr mols)) + padding + ) + ) + )) + + + + +(define (fontify-text font-metric text) + "Set TEXT with font FONT-METRIC, returning a molecule." + (let* ((b (ly-text-dimension font-metric text))) + (ly-make-molecule + (ly-fontify-atom font-metric `(text ,text)) (car b) (cdr b)) + )) + +(define (other-axis a) + (remainder (+ a 1) 2)) + +(define (bracketify-molecule mol axis thick protusion padding) + "Add brackets around MOL, producing a new molecule." + + (let* ( + (ext (ly-get-molecule-extent mol axis)) + (lb (ly-bracket axis ext -1 thick protusion)) + (rb (ly-bracket axis ext 1 thick protusion)) + ) + (set! mol (ly-combine-molecule-at-edge mol (other-axis axis) 1 lb padding)) + (set! mol (ly-combine-molecule-at-edge mol (other-axis axis) -1 rb padding)) + mol + )) -- 2.39.5