From 8903693f3b43cf4b196b558aa939b9e148ddaec1 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 8 May 2000 21:23:58 +0200 Subject: [PATCH] patch::: 1.3.48.jcn1 1.3.47.jcn3 =========== * Rewrite of chord-name production in scheme. There are two major styles now, banter and american. To get american style, use \property ChordNames.chordNameStyle = "american" Most anything should be possible now. See input/test/american-chords.ly * Added isinf check to configure.in, and isinf macro from guile to bezier.cc; solaris has no isinf (). * Fixed star-spangled-banner with not-so-nice \bar "|." fix. Almost perfect now. * Added output property to regression test. * Fixed warning of creating existing outdir. * Added `Mark' interface to text-items that are marks (thanks, HW). 1.3.46.jcn2 =========== --- CHANGES | 25 ++ Documentation/regression-test.tely | 7 + VERSION | 2 +- config.hh.in | 3 + configure.in | 2 +- input/star-spangled-banner.ly | 26 +- input/test/american-chords.ly | 46 +++ input/test/generic-output-property.ly | 29 +- input/test/move-mark.ly | 20 ++ lily/bezier.cc | 10 + lily/chord-name.cc | 356 ++++++---------------- lily/chord.cc | 74 +---- lily/include/chord-name.hh | 13 - lily/include/chord.hh | 1 - lily/mark-engraver.cc | 6 +- scm/chord-names.scm | 377 +++++++++++++++++++++--- scm/generic-property.scm | 3 +- stepmake/stepmake/generic-targets.make | 2 +- stepmake/stepmake/metafont-rules.make | 4 +- stepmake/stepmake/metafont-targets.make | 2 +- 20 files changed, 580 insertions(+), 428 deletions(-) create mode 100644 input/test/american-chords.ly create mode 100644 input/test/move-mark.ly diff --git a/CHANGES b/CHANGES index f9de694dfb..901d0650ab 100644 --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,28 @@ +1.3.47.jcn3 +=========== + +* Rewrite of chord-name production in scheme. There are two major styles + now, banter and american. To get american style, use + + \property ChordNames.chordNameStyle = "american" + + Most anything should be possible now. See input/test/american-chords.ly + +* Added isinf check to configure.in, and isinf macro from guile to + bezier.cc; solaris has no isinf (). + +* Fixed star-spangled-banner with not-so-nice \bar "|." fix. Almost + perfect now. + +* Added output property to regression test. + +* Fixed warning of creating existing outdir. + +* Added `Mark' interface to text-items that are marks (thanks, HW). + +1.3.46.jcn2 +=========== + 1.3.47.mb2 =========== diff --git a/Documentation/regression-test.tely b/Documentation/regression-test.tely index 82025c42ef..3aa7844041 100644 --- a/Documentation/regression-test.tely +++ b/Documentation/regression-test.tely @@ -360,4 +360,11 @@ signatures. \mu delafile{time.ly} @end ignore +@section Hacks and Features + +As a last resort, the placement of items can be adjusted manually. + +@mudelafile{generic-output-property.ly} + @bye + diff --git a/VERSION b/VERSION index e81a8b6f4c..f5024157bd 100644 --- a/VERSION +++ b/VERSION @@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=3 PATCH_LEVEL=48 -MY_PATCH_LEVEL= +MY_PATCH_LEVEL=jcn1 # use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/config.hh.in b/config.hh.in index 4eba148977..833c0eec00 100644 --- a/config.hh.in +++ b/config.hh.in @@ -21,6 +21,9 @@ /* define if you have gettext */ #define HAVE_GETTEXT 0 +/* define if you have isinf */ +#define HAVE_ISINF 0 + /* define if explicit instantiation is needed */ #undef NEED_EXPLICIT_INSTANTIATION diff --git a/configure.in b/configure.in index 0b83441d4d..9d2b9cc58b 100644 --- a/configure.in +++ b/configure.in @@ -50,7 +50,7 @@ dnl AC_CHECK_SEARCH_RESULT($FIND, find, Please use --enable-tex-dir) AC_FUNC_MEMCMP AC_FUNC_VPRINTF -AC_CHECK_FUNCS(memmem snprintf vsnprintf gettext) +AC_CHECK_FUNCS(memmem snprintf vsnprintf gettext isinf) AC_DEFINE_UNQUOTED(TOPLEVEL_VERSION, "${FULL_VERSION}") AC_DEFINE_UNQUOTED(FLOWER_VERSION, "${FULL_FLOWER_VERSION}") diff --git a/input/star-spangled-banner.ly b/input/star-spangled-banner.ly index 4c14e483e5..8fbb694dcd 100644 --- a/input/star-spangled-banner.ly +++ b/input/star-spangled-banner.ly @@ -8,7 +8,8 @@ http://www.Arkkra.com/doc/star.ps % TODO: % -% * centre non-melismata lyrics under notehead: +% * centre non-melismata lyrics (where there's only one verse!) under +% notehead: % % l c c c l % ___ @@ -16,8 +17,8 @@ http://www.Arkkra.com/doc/star.ps % x|()x| x| x| x| x|( )x| % Oh_____say can you see % +% NOT! % -% * repeat colons in Lyrics / running into barline of 'Whose broad' % % * slur/lyric clash % @@ -108,14 +109,10 @@ text = \lyrics { say, can you | see, by the dawn's ear- ly light What so proud- ly we hailed, At the twi- light's last gleam- ing. - %Whose broad - %Whose broad_justoseewhatsgoingonhere \bar ":|"; % Ah, it seems that this context stops to exist just before % the :| barline is set, and doesn't see its width? - % Adding one here fixes running into the span-bar, - % but adds yet another repeatcolon -- maybe we can fix that - % elsewhere. - Whose broad \bar ":|"; + % Ugly fix: + Whose broad \bar "|."; } { stripes and bright stars, through the per- il- ous fight, @@ -176,23 +173,10 @@ text = \lyrics { \translator { \LyricsContext \consists "Span_bar_engraver"; - % Urg - % 'Whose broad' still runs into the :| span-bar - %\consists "Span_bar_engraver"; - - % Urg - % Moet iemand kunnen begrijpen hoe die visibilities - % werken? - %% #'Span_bar_engraver-visibility = #all-invisible - "Span_bar_engraver-visibility" = #all-invisible - "Bar_engraver-visibility" = #all-invisible - "Span_bar::visibility-lambda" = #all-invisible } \translator { \LyricsVoiceContext \consists "Bar_engraver"; - "Bar_engraver-visibility" = #all-invisible - "Bar::visibility-lambda" = #all-invisible } } \midi { diff --git a/input/test/american-chords.ly b/input/test/american-chords.ly new file mode 100644 index 0000000000..3c812fce6d --- /dev/null +++ b/input/test/american-chords.ly @@ -0,0 +1,46 @@ +#(set! chord::names-alist-american + (append + '( + + ) + chord::names-alist-american)) + +chord = \notes\transpose c''\chords{ +\property ChordNames.chordNameStyle = "american" +c +c:m +c:m5- +c:5^3 +c:4^3 +c:5+ +c:2^3 +c:m5-.7- +c:7+ +c:7.4^3 +c:5+.7 +c:m5-.7 +c:5-.7+ +c:m7+ +c:m7 +c:7 +c:6 +c:m6 +c:9^7 +c:6.9^7 +c:9 +c:7+.9 +} + +\score{ +< +\context ChordNames \chord +\context Staff \chord +> + \paper + { + \translator { \ChordNameContext chordNameWordSpace = #1 } + \translator { \LyricsContext textScriptWordSpace = #0.3 } + } +} + +% (((0 . 0) (2 . -1) (4 . 0)) . ("Bar" . ("script" . "Baz"))) diff --git a/input/test/generic-output-property.ly b/input/test/generic-output-property.ly index 3a7661efcc..0e7d2695b7 100644 --- a/input/test/generic-output-property.ly +++ b/input/test/generic-output-property.ly @@ -1,10 +1,23 @@ - -\score -{ -\notes { - c''4 - \outputproperty #(make-type-checker 'Note_head) #'staff-position = #20 - c''4 - +\score{ + \notes\relative c''{ + \outputproperty #(make-type-checker 'Note_head) + #'extra-offset = #'(2 . 3) + c2 + c + \context Score { + \outputproperty #(make-type-checker 'Mark) + #'extra-offset = #'(-1 . 4) + } + \mark A; + d1 + \mark; + e +} +\paper{ + linewidth=-1.0; + \translator { + \ScoreContext + \consists "Mark_engraver"; + } } } diff --git a/input/test/move-mark.ly b/input/test/move-mark.ly new file mode 100644 index 0000000000..13716b5f0f --- /dev/null +++ b/input/test/move-mark.ly @@ -0,0 +1,20 @@ +\score{ +\context Staff \notes\relative c''{ + c1 + \context Score { + \outputproperty #(make-type-checker 'Mark) + #'extra-offset = #'(-1 . 4) + } + \mark A; + d + \mark ; + e +} +\paper{ + linewidth=-1.0; + \translator { + \ScoreContext + \consists "Mark_engraver"; + } +} +} diff --git a/lily/bezier.cc b/lily/bezier.cc index 4cb2b3682e..6f2c011692 100644 --- a/lily/bezier.cc +++ b/lily/bezier.cc @@ -7,6 +7,16 @@ */ #include +#include "config.h" + +/* + IS_INF tests its floating point number for infiniteness + Ripped from guile's number.c. Solaris has no isinf (). + */ +#if ! HAVE_ISINF + #define isinf(x) ((x) == (x) / 2) +#endif + #include "bezier.hh" #include "polynomial.hh" diff --git a/lily/chord-name.cc b/lily/chord-name.cc index 75a16226c9..bb6fbbc1ea 100644 --- a/lily/chord-name.cc +++ b/lily/chord-name.cc @@ -26,298 +26,126 @@ ("style" . "text") */ Molecule -Chord_name::ly_word2molecule (SCM scm) const +Chord_name::ly_word2molecule (SCM word) const { - String style; - if (gh_pair_p (scm)) + Dictionary option_dict; + if (gh_pair_p (word)) { - SCM s = gh_car (scm); - if (gh_string_p (s)) - style = ly_scm2string (s); - scm = gh_cdr (scm); + SCM options = gh_cdr (word); + word = gh_car (word); + while (gh_pair_p (options)) + { + SCM option = gh_car (options); + if (option != SCM_UNDEFINED && option != SCM_BOOL_F + && gh_pair_p (option)) + { + SCM key = gh_car (option); + SCM val = gh_cdr (option); + String k; + if (gh_symbol_p (key)) + k = ly_symbol2string (key); + else if (gh_string_p (key)) + k = ly_scm2string (key); + else + continue; + option_dict[k] = val; + } + options = gh_cdr (options); + } + } + Real ex = lookup_l ()->text ("", "x", paper_l ()).extent + ()[Y_AXIS].length (); + if (gh_string_p (word)) + { + String w = ly_scm2string (word); + Molecule mol; + Offset offset; + + int size = 0; + if (option_dict.elem_b ("size")) + size = gh_scm2int (option_dict["size"]); + + String style; + if (option_dict.elem_b ("style")) + style = ly_scm2string (option_dict["style"]); + + if (option_dict.elem_b ("type") + && ly_scm2string (option_dict["type"]) == "super") + { + Real super_y = ex / 2; + //super_y += -acc.extent ()[Y_AXIS][MIN]; + offset = Offset (0, super_y); + if (!size) + size = -2; + } + if (option_dict.elem_b ("offset")) + { + // hmm + SCM s = option_dict["offset"]; + if (gh_pair_p (s)) + offset = Offset (gh_scm2double (gh_car (s)), + gh_scm2double (gh_cdr (s))) * ex; + } + if (option_dict.elem_b ("font") + && ly_scm2string (option_dict["font"]) == "feta") + mol = paper_l ()->lookup_l (size)->afm_find (w); + else + mol = paper_l ()->lookup_l (size)->text (style, w, paper_l ()); + + mol.translate (offset); + return mol; } - if (gh_string_p (scm)) - return lookup_l ()->text (style, ly_scm2string (scm), paper_l ()); return Molecule (); } /* - scm is word or list of words: - word - (word word) + ;; text: list of word + ;; word: string + optional list of property + ;; property: align, kern, font (?), size */ Molecule -Chord_name::ly_text2molecule (SCM scm) const +Chord_name::ly_text2molecule (SCM text) const { Molecule mol; - if (gh_list_p (scm)) + if (gh_list_p (text)) { - while (gh_cdr (scm) != SCM_EOL) + while (gh_cdr (text) != SCM_EOL) { - Molecule m = ly_word2molecule (gh_car (scm)); + Molecule m = ly_word2molecule (gh_car (text)); if (!m.empty_b ()) mol.add_at_edge (X_AXIS, RIGHT, m, 0); - scm = gh_cdr (scm); + text = gh_cdr (text); } - scm = gh_car (scm); + text = gh_car (text); } - Molecule m = ly_word2molecule (scm); + Molecule m = ly_word2molecule (text); if (!m.empty_b ()) mol.add_at_edge (X_AXIS, RIGHT, m, 0); return mol; } -Molecule -Chord_name::pitch2molecule (Musical_pitch p) const -{ - SCM name = scm_eval (gh_list (ly_symbol2scm ("user-pitch-name"), - ly_quote_scm (p.to_scm ()), - SCM_UNDEFINED)); - - if (name != SCM_UNSPECIFIED) - { - return ly_text2molecule (name); - } - - Molecule mol = lookup_l ()->text ("", p.str ().left_str (1).upper_str (), paper_l ()); - - /* - We want the smaller size, even if we're big ourselves. - */ - if (p.accidental_i_) - { - Molecule acc = paper_l ()->lookup_l (-3)->afm_find - (String ("accidentals-") + to_str (p.accidental_i_)); - // urg, howto get a good superscript_y? - Real super_y = lookup_l ()->text ("", "x", paper_l ()).extent - ()[Y_AXIS].length () / 2; - super_y += -acc.extent ()[Y_AXIS][MIN]; - acc.translate_axis (super_y, Y_AXIS); - mol.add_at_edge (X_AXIS, RIGHT, acc, 0.0); - } - - return mol; -} - -Musical_pitch -diff_pitch (Musical_pitch tonic, Musical_pitch p) -{ - Musical_pitch diff (p.notename_i_ - tonic.notename_i_, - p.accidental_i_ - tonic.accidental_i_, - p.octave_i_ - tonic.octave_i_); - - while (diff.notename_i_ >= 7) - { - diff.notename_i_ -= 7; - diff.octave_i_ ++; - } - while (diff.notename_i_ < 0) - { - diff.notename_i_ += 7; - diff.octave_i_ --; - } - - diff.accidental_i_ -= (tonic.semitone_pitch () + diff.semitone_pitch ()) - - p.semitone_pitch (); - - return diff; -} - -/* - JUNKME - */ -bool -Chord_name::user_chord_name (Array pitch_arr, Chord_mol* name_p) const -{ - Array chord_type = pitch_arr; - Chord::rebuild_transpose (&chord_type, diff_pitch (pitch_arr[0], Musical_pitch (0)), false); - - SCM chord = SCM_EOL; - for (int i= chord_type.size (); i--; ) - chord = gh_cons (chord_type[i].to_scm (), chord); - - - SCM name = scm_eval (gh_list (ly_symbol2scm ("user-chord-name"), - ly_quote_scm (chord), - SCM_UNDEFINED)); - if (gh_pair_p (name)) - { - name_p->modifier_mol = ly_text2molecule (gh_car (name)); - name_p->addition_mol = ly_text2molecule (gh_cdr (name)); - return true; - } - return false; -} - -void -Chord_name::banter (Array pitch_arr, Chord_mol* name_p) const -{ - Array add_arr; - Array sub_arr; - Chord::find_additions_and_subtractions (pitch_arr, &add_arr, &sub_arr); - - Array scale; - for (int i=0; i < 7; i++) - scale.push (Musical_pitch (i)); - - Musical_pitch tonic = pitch_arr[0]; - Chord::rebuild_transpose (&scale, tonic, true); - - /* - Does chord include this step? -1 if flat - */ - int has[16]; - for (int i=0; i<16; i++) - has[i] = 0; - - String mod_str; - String add_str; - String sep_str; - for (int i = 0; i < add_arr.size (); i++) - { - Musical_pitch p = add_arr[i]; - int step = Chord::step_i (tonic, p); - int accidental = p.accidental_i_ - scale[(step - 1) % 7].accidental_i_; - if ((step < 16) && (has[step] != -1)) - has[step] = accidental == -1 ? -1 : 1; - // only from guile table ? - if ((step == 3) && (accidental == -1)) - { - mod_str = "m"; - } - else if (accidental - || (!(step % 2) - || ((i == add_arr.size () - 1) && (step > 5)))) - { - add_str += sep_str; - sep_str = "/"; - if ((step == 7) && (accidental == 1)) - { - add_str += "maj7"; - } - else - { - add_str += to_str (step); - if (accidental) - add_str += accidental < 0 ? "-" : "+"; - } - } - } - - for (int i = 0; i < sub_arr.size (); i++) - { - Musical_pitch p = sub_arr[i]; - int step = Chord::step_i (tonic, p); - /* - if additions include 2 or 4, assume sus2/4 and don't display 'no3' - */ - if (!((step == 3) && (has[2] || has[4]))) - { - add_str += sep_str + "no" + to_str (step); - sep_str = "/"; - } - } - - if (mod_str.length_i ()) - name_p->modifier_mol.add_at_edge (X_AXIS, RIGHT, - lookup_l ()->text ("roman", mod_str, paper_l ()), 0); - if (add_str.length_i ()) - { - if (!name_p->addition_mol.empty_b ()) - add_str = "/" + add_str; - name_p->addition_mol.add_at_edge (X_AXIS, RIGHT, - lookup_l ()->text ("script", add_str, paper_l ()), 0); - } -} - -/* - TODO: - fix silly to-and-fro scm conversions - */ Molecule Chord_name::do_brew_molecule () const { - Array pitch_arr; - - for (SCM s = get_elt_property ("pitches"); s != SCM_EOL; s = gh_cdr (s)) - pitch_arr.push (Musical_pitch (gh_car (s))); - - Musical_pitch tonic = pitch_arr[0]; - - Chord_mol name; - name.tonic_mol = pitch2molecule (tonic); - - /* - if user has explicitely listed chord name, use that - - TODO - urg - maybe we should check all sub-lists of pitches, not - just full list and base triad? - */ - if (!user_chord_name (pitch_arr, &name)) - { - /* - else, check if user has listed base triad - use user base name and add banter for remaining part - */ - if ((pitch_arr.size () > 2) - && user_chord_name (pitch_arr.slice (0, 3), &name)) - { - Array base = Chord::base_arr (tonic); - base.concat (pitch_arr.slice (3, pitch_arr.size ())); - banter (base, &name); - } - /* - else, use pure banter - */ - else - { - banter (pitch_arr, &name); - } - } + SCM style = get_elt_property ("style"); + if (style == SCM_UNDEFINED) + style = ly_str02scm ("banter"); - SCM s = get_elt_property ("inversion"); - if (s != SCM_UNDEFINED) - { - name.inversion_mol = lookup_l ()->text ("", "/", paper_l ()); - Musical_pitch p (s); + SCM inversion = get_elt_property ("inversion"); + if (inversion == SCM_UNDEFINED) + inversion = SCM_BOOL_F; - Molecule mol = pitch2molecule (p); - name.inversion_mol.add_at_edge (X_AXIS, RIGHT, mol, 0); - } + SCM bass = get_elt_property ("bass"); + if (bass == SCM_UNDEFINED) + bass = SCM_BOOL_F; - s = get_elt_property ("bass"); - if (s != SCM_UNDEFINED) - { - name.bass_mol = lookup_l ()->text ("", "/", paper_l ()); - Musical_pitch p (s); - Molecule mol = pitch2molecule (p); - name.bass_mol.add_at_edge (X_AXIS, RIGHT, mol, 0); - } - - // urg, howto get a good superscript_y? - Real super_y = lookup_l ()->text ("", "x", paper_l ()).extent - ()[Y_AXIS].length () / 2; - if (!name.addition_mol.empty_b ()) - name.addition_mol.translate (Offset (0, super_y)); - - Molecule mol; - mol.add_at_edge (X_AXIS, RIGHT, name.tonic_mol, 0); - // huh? - if (!name.modifier_mol.empty_b ()) - mol.add_at_edge (X_AXIS, RIGHT, name.modifier_mol, 0); - if (!name.addition_mol.empty_b ()) - mol.add_at_edge (X_AXIS, RIGHT, name.addition_mol, 0); - if (!name.inversion_mol.empty_b ()) - mol.add_at_edge (X_AXIS, RIGHT, name.inversion_mol, 0); - if (!name.bass_mol.empty_b ()) - mol.add_at_edge (X_AXIS, RIGHT, name.bass_mol, 0); + SCM pitches = get_elt_property ("pitches"); - s = get_elt_property ("word-space"); - if (gh_number_p (s)) - mol.dim_.interval_a_[X_AXIS][RIGHT] += gh_scm2double (s) - * staff_symbol_referencer (this).staff_space (); + SCM text = scm_eval (gh_list (ly_symbol2scm ("chord::user-name"), + style, + ly_quote_scm (pitches), + ly_quote_scm (gh_cons (inversion, bass)), + SCM_UNDEFINED)); - return mol; + return ly_text2molecule (text); } diff --git a/lily/chord.cc b/lily/chord.cc index e188062f0e..8a524f0110 100644 --- a/lily/chord.cc +++ b/lily/chord.cc @@ -295,6 +295,10 @@ Chord::step_i (Musical_pitch tonic, Musical_pitch p) return i; } +/* + JUNKME. + do something smarter. + */ Array Chord::missing_thirds_pitch_arr (Array const* pitch_arr_p) { @@ -377,76 +381,6 @@ Chord::to_pitch_arr () const return pitch_arr; } -void -Chord::find_additions_and_subtractions (Array pitch_arr, Array* add_arr_p, Array* sub_arr_p) -{ - Musical_pitch tonic = pitch_arr[0]; - /* - construct an array of thirds for a normal chord - */ - Array all_arr; - all_arr.push (tonic); - if (step_i (tonic, pitch_arr.top ()) >= 5) - all_arr.push (pitch_arr.top ()); - else - all_arr.push (base_arr (tonic).top ()); - all_arr.concat (missing_thirds_pitch_arr (&all_arr)); - all_arr.sort (Musical_pitch::compare); - - int i = 0; - int j = 0; - Musical_pitch last_extra = tonic; - while ((i < all_arr.size ()) || (j < pitch_arr.size ())) - { - Musical_pitch a = all_arr [i push (p); - last_extra = p; - (j < pitch_arr.size ()) ? j++ : i++; - } - /* - a third is missing: chord subtraction - */ - else - { - if (last_extra.notename_i_ != a.notename_i_) - sub_arr_p->push (a); - (i < all_arr.size ()) ? i++ : j++; - last_extra = tonic; - } - } - - /* add missing basic steps */ - if (step_i (tonic, pitch_arr.top ()) < 3) - sub_arr_p->push (base_arr (tonic)[1]); - if (step_i (tonic, pitch_arr.top ()) < 5) - sub_arr_p->push (base_arr (tonic).top ()); - - /* - add highest addition, because it names chord, if greater than 5 - or non-standard - (1, 3 and) 5 not additions: part of normal chord - */ - if ((step_i (tonic, pitch_arr.top ()) > 5) - || pitch_arr.top ().accidental_i_) - add_arr_p->push (pitch_arr.top ()); -} - - /* This routine tries to guess tonic in a possibly inversed chord, ie should produce: C. diff --git a/lily/include/chord-name.hh b/lily/include/chord-name.hh index fa9cba3a87..3bdf747a0b 100644 --- a/lily/include/chord-name.hh +++ b/lily/include/chord-name.hh @@ -13,16 +13,6 @@ #include "item.hh" #include "molecule.hh" -class Chord_mol -{ -public: - Molecule tonic_mol; - Molecule modifier_mol; - Molecule addition_mol; - Molecule inversion_mol; - Molecule bass_mol; -}; - /** elt_properties: pitches: list of musical-pitch @@ -35,9 +25,6 @@ public: VIRTUAL_COPY_CONS (Score_element); Molecule ly_word2molecule (SCM scm) const; Molecule ly_text2molecule (SCM scm) const; - Molecule pitch2molecule (Musical_pitch p) const; - bool user_chord_name (Array pitch_arr, Chord_mol* name_p) const; - void banter (Array pitch_arr, Chord_mol* name_p) const; protected: virtual Molecule do_brew_molecule () const; diff --git a/lily/include/chord.hh b/lily/include/chord.hh index 2d13e75deb..ce85501bf8 100644 --- a/lily/include/chord.hh +++ b/lily/include/chord.hh @@ -22,7 +22,6 @@ class Chord { public: static Array base_arr (Musical_pitch p); - static void find_additions_and_subtractions(Array pitch_arr, Array* add_arr_p, Array* sub_arr_p); static int find_tonic_i (Array const*); static int find_pitch_i (Array const*, Musical_pitch p); static int find_notename_i (Array const*, Musical_pitch p); diff --git a/lily/mark-engraver.cc b/lily/mark-engraver.cc index 3cc91cdbbf..0aa80fc411 100644 --- a/lily/mark-engraver.cc +++ b/lily/mark-engraver.cc @@ -6,7 +6,7 @@ (c) 1998--2000 Jan Nieuwenhuizen */ - +#include #include "bar.hh" #include "clef-item.hh" #include "command-request.hh" @@ -21,7 +21,8 @@ #include "staff-symbol-referencer.hh" #include "staff-symbol.hh" #include "text-item.hh" -#include +#include "group-interface.hh" + /** put stuff over or next to bars. Examples: bar numbers, marginal notes, rehearsal marks. @@ -109,6 +110,7 @@ Mark_engraver::create_items (Request *rq) text_p_ = new Text_item; text_p_->set_elt_property ("breakable", SCM_BOOL_T); // ugh + Group_interface (text_p_, "interfaces").add_thing (ly_symbol2scm ("Mark")); Side_position_interface staffside(text_p_); staffside.set_axis (Y_AXIS); diff --git a/scm/chord-names.scm b/scm/chord-names.scm index 7a8777fbc7..738fdb4abe 100644 --- a/scm/chord-names.scm +++ b/scm/chord-names.scm @@ -1,56 +1,349 @@ -;; note-name: (note . accidental) -;; list: (list-of-pitches . (modifier-string . addition-subtraction-string)) +;;; chord.scm -- to be included in/to replace chord-name.scm +;;; 2000 janneke@gnu.org +;;; -;; if a complete chord is found, use name -;; if a chord's base triad is found (c e g), use name +(use-modules + (ice-9 debug) + ;; urg, these two only to guess if a '/' is needed to separate + ;; user-chord-name and additions/subtractions + (ice-9 format) + (ice-9 regex) + ) -(define note-names-alist '()) -(set! note-names-alist - (append - '( - ; use these for German naming - ;((6 . 0) . ("H" "")) - ;((6 . -1) . ("B" ("feta-1" . ""))) - - ; C-p/C-r current feta chars for sharp/flat - ; don't use them: ly2dvi breaks (inputenc package) - ;((0 . 1) . ("C" ("feta-1" . ""))) - ;((0 . -1) . ("C" ("feta-1" . ""))) - ) - note-names-alist)) +;; +;; (octave notename accidental) +;; -(define (pitch->note-name pitch) - (cons (cadr pitch) (caddr pitch))) - -(define (user-pitch-name pitch) - (let ((entry (assoc (pitch->note-name pitch) note-names-alist))) - (if entry - (cdr entry)))) +;; +;; text: list of word +;; word: string + optional list of property +;; property: size, style, font, super, offset +;; -(define chord-names-alist '()) -(set! chord-names-alist +;; TODO +;; +;; * clean split of base/banter/american stuff +;; * text definition is rather ad-hoc +;; * do without format module +;; * finish and check american names +;; * make notename (tonic) configurable from mudela +;; * fix append/cons stuff in inner-name-banter +;; + + +;;;;;;;;; +(define chord::names-alist-banter '()) +(set! chord::names-alist-banter (append - '( + '( ; C iso C.no3.no5 - (((0 . 0)) . (#f . #f)) + (((0 . 0)) . #f) ; C iso C.no5 - (((0 . 0) (2 . 0)) . (#f . #f)) + (((0 . 0) (2 . 0)) . #f) ; Cm iso Cm.no5 - (((0 . 0) (2 . -1)) . ("m" . #f)) + (((0 . 0) (2 . -1)) . ("m")) + ; C2 iso C2.no3 + (((0 . 0) (1 . 0) (4 . 0)) . (("2" (type . "super")))) + ; C4 iso C4.no3 + (((0 . 0) (3 . 0) (4 . 0)) . (("4" (type . "super")))) ; Cdim iso Cm5- - (((0 . 0) (2 . -1) (4 . -1)) . ("dim" . #f)) + (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) ; Co iso Cm5-7- ; urg - ; (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" . ("feta-1" . "."))) - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (#f . ("script" . "o"))) + (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o" (type . "super")))) ; Cdim9 - (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" . ("script" . "9"))) - (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" . ("script" . "11"))) + (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" ("9" (type . "super")))) + (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" ("11" (type . "super")))) ) - chord-names-alist)) + chord::names-alist-banter)) + + +(define chord::names-alist-american '()) +(set! chord::names-alist-american + (append + '( + (((0 . 0)) . #f) + (((0 . 0) (2 . 0)) . #f) + (((0 . 0) (2 . -1)) . ("m")) + (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) + (((0 . 0) (4 . 0)) . (("5" (type . "super")))) + (((0 . 0) (3 . 0) (4 . 0)) . ("sus")) + (((0 . 0) (2 . -1) (4 . -1)) . (("o" (type . "super")))) + (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o7" (type . "super")))) + (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (("x7" (type . "super")))) + + (((0 . 0) (2 . 0) (4 . 1)) . ("aug")) + (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . (("aug" ("7" (type . "super"))))) + + (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (("maj7" (type . "super")) ("accidentals--1" (font . "feta") (type . "super")) ("5" (type . "super")))) + + (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . (("7sus4" (type . "super")))) + + (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (("maj6" (type . "super")))) + ;; dont need this? + ;(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6" . "")) + + ;; c = 0, d = 1 + ;;(((0 . 0) (2 . 0) (4 . 0) (8 . 0)) . ("add9" . "")) + ;;(((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("" . (("script" . "add9")))) + + ;; we don't want the '/no7' + ;;(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (8 . 0)) . ("6/9" . "")) + ;;(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (("script" . "6/9")))) + + ;;already have this? + ;;(((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9" . "")) + + ) + chord::names-alist-american)) + +;;;;;;;;;; + + +(define (pitch->note-name pitch) + (cons (cadr pitch) (caddr pitch))) + +(define (pitch->text pitch) + (cons + (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65))) + (if (= (caddr pitch) 0) + '() + (list (list (string-append "accidentals-" + (number->string (caddr pitch))) + '(font . "feta")))))) + +(define (step->text pitch) + (string-append + (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8))) + (case (caddr pitch) + ((-2) "--") + ((-1) "-") + ((0) "") + ((1) "+") + ((2) "++")))) + +(define (pitch->text-banter pitch) + (pitch->text pitch)) + +(define (step->text-banter pitch) + (if (= (cadr pitch) 6) + (case (caddr pitch) + ((-2) "7-") + ((-1) "7") + ((0) "maj7") + ((1) "7+") + ((2) "7+")) + (step->text pitch))) + +(define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11))) + +(define (pitch::semitone pitch) + (+ (* (car pitch) 12) + (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7)) + (caddr pitch))) + +(define (pitch::transpose pitch delta) + (let ((simple-octave (+ (car pitch) (car delta))) + (simple-notename (+ (cadr pitch) (cadr delta)))) + (let ((octave (+ simple-octave (quotient simple-notename 7))) + (notename (modulo simple-notename 7))) + (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta)) + (pitch::semitone `(,octave ,notename 0))))) + `(,octave ,notename ,accidental))))) + +(define (pitch::diff pitch tonic) + (let ((simple-octave (- (car pitch) (car tonic))) + (simple-notename (- (cadr pitch) (cadr tonic)))) + (let ((octave (+ simple-octave (quotient simple-notename 7) + (if (< simple-notename 0) -1 0))) + (notename (modulo simple-notename 7))) + (let ((accidental (- (pitch::semitone pitch) + (pitch::semitone tonic) + (pitch::semitone `(,octave ,notename 0))))) + `(,octave ,notename ,accidental))))) + +(define (pitch::note-pitch pitch) + (+ (* (car pitch) 7) (cadr pitch))) + +(define (chord::step tonic pitch) + (- (pitch::note-pitch pitch) (pitch::note-pitch tonic))) + +;; text: list of word +;; word: string + optional list of property +;; property: align, kern, font (?), size + +(define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0))) + +;; compute the relative-to-tonic pitch that goes with 'step' +(define (chord::step-pitch tonic step) + ;; urg, we only do this for thirds + (if (= (modulo step 2) 0) + '(0 0 0) + (let loop ((i 1) (pitch tonic)) + (if (= i step) pitch + (loop (+ i 2) + (pitch::transpose + pitch `(0 2 ,(vector-ref chord::minor-major-vec + ;; -1 (step=1 -> vector=0) + 7 = 6 + (modulo (+ i 6) 7))))))))) + +;; find the pitches that are not part of `normal' chord +(define (chord::additions chord-pitches) + (let ((tonic (car chord-pitches))) + ;; walk the chord steps: 1, 3, 5 + (let loop ((step 1) (pitches chord-pitches) (additions '())) + (if (pair? pitches) + (let* ((pitch (car pitches)) + (p-step (+ (- (pitch::note-pitch pitch) + (pitch::note-pitch tonic)) + 1))) + ;; pitch is an addition if + (if (or + ;; it comes before this step or + (< p-step step) + ;; its step is even or + (= (modulo p-step 2) 0) + ;; has same step, but different accidental or + (and (= p-step step) + (not (equal? pitch (chord::step-pitch tonic step)))) + ;; is the last of the chord and not one of base thirds + (and (> p-step 5) + (= (length pitches) 1))) + (loop step (cdr pitches) (cons pitch additions)) + (if (= p-step step) + (loop step (cdr pitches) additions) + (loop (+ step 2) pitches additions)))) + (reverse additions))))) + +;; find the pitches that are missing from `normal' chord +(define (chord::subtractions chord-pitches) + (let ((tonic (car chord-pitches))) + (let loop ((step 1) (pitches chord-pitches) (subtractions '())) + (if (pair? pitches) + (let* ((pitch (car pitches)) + (p-step (+ (- (pitch::note-pitch pitch) + (pitch::note-pitch tonic)) + 1))) + ;; pitch is an subtraction if + ;; a step is missing or + (if (> p-step step) + (loop (+ step 2) pitches + (cons (chord::step-pitch tonic step) subtractions)) + ;; there are no pitches left, but base thirds are not yet done and + (if (and (<= step 5) + (= (length pitches) 1)) + ;; present pitch is not missing step + (if (= p-step step) + (loop (+ step 2) pitches subtractions) + (loop (+ step 2) pitches + (cons (chord::step-pitch tonic step) subtractions))) + (if (= p-step step) + (loop (+ step 2) (cdr pitches) subtractions) + (loop step (cdr pitches) subtractions))))) + (reverse subtractions))))) + +;; combine tonic, user-specified chordname, +;; additions, subtractions and base or inversion to chord name +;; +(define (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion) + (apply append (pitch->text-banter tonic) + (if user-name user-name '()) + ;; why does list->string not work, format seems only hope... + (if (and (string-match "super" (format "~s" user-name)) + (or (pair? additions) + (pair? subtractions))) + '(("/" (type . "super"))) + '()) + (let loop ((from additions) (to '())) + (if (pair? from) + (let ((p (car from))) + (loop (cdr from) + (append to + (cons + (cons (step->text-banter p) '((type . "super"))) + (if (or (pair? (cdr from)) + (pair? subtractions)) + '(("/" (type . "super"))) + '()))))) + to)) + (let loop ((from subtractions) (to '())) + (if (pair? from) + (let ((p (car from))) + (loop (cdr from) + (append to + (cons '("no" (type . "super")) + (cons + (cons (step->text-banter p) '((type . "super"))) + (if (pair? (cdr from)) + '(("/" (type . "super"))) + '())))))) + to)) + (if (and (pair? base-and-inversion) + (or (car base-and-inversion) + (cdr base-and-inversion))) + (cons "/" (append + (if (car base-and-inversion) + (pitch->text + (car base-and-inversion)) + (pitch->text + (cdr base-and-inversion))) + '())) + '()) + '())) + +(define (chord::name-banter tonic user-name pitches base-and-inversion) + (let ((additions (chord::additions pitches)) + (subtractions (chord::subtractions pitches))) + (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion))) + +;; american chordnames use no "no", +;; but otherwise very similar to banter for now +(define (chord::name-american tonic user-name pitches base-and-inversion) + (let ((additions (chord::additions pitches)) + (subtractions #f)) + (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion))) + +;; C++ entry point +;; +;; Check for each subset of chord, full chord first, if there's a +;; user-override. Split the chord into user-overridden and to-be-done +;; parts, complete the missing user-override matched part with normal +;; chord to be name-calculated. +;; +(define (chord::user-name style pitches base-and-inversion) + ;(display "pitches:") (display pitches) (newline) + ;(display "style:") (display style) (newline) + ;(display "b&i:") (display base-and-inversion) (newline) + (let ((diff (pitch::diff '(0 0 0) (car pitches))) + (name-func + (eval (string->symbol (string-append "chord::name-" style)))) + (names-alist + (eval (string->symbol (string-append "chord::names-alist-" style))))) + (let loop ((note-names (reverse pitches)) + (chord '()) + (user-name #f)) + (if (pair? note-names) + (let ((entry (assoc + (reverse + (map (lambda (x) + (pitch->note-name (pitch::transpose x diff))) + note-names)) + names-alist))) + (if entry + ;; urg? found: break loop + (loop '() chord (cdr entry)) + (loop (cdr note-names) (cons (car note-names) chord) #f))) + (let* ((transposed (if pitches + (map (lambda (x) (pitch::transpose x diff)) chord) + '())) + (matched (if (= (length chord) 0) + 3 + (- (length pitches) (length chord)))) + (completed + (append (do ((i matched (- i 1)) + (base '() (cons `(0 ,(* (- i 1) 2) 0) base))) + ((= i 0) base) + ()) + transposed))) + (name-func (car pitches) user-name completed base-and-inversion)))))) -(define (user-chord-name chord) - (let ((entry (assoc (map (lambda (x) (pitch->note-name x)) chord) - chord-names-alist))) - (if entry - (cdr entry)))) diff --git a/scm/generic-property.scm b/scm/generic-property.scm index 3145084cc7..1506982fb6 100644 --- a/scm/generic-property.scm +++ b/scm/generic-property.scm @@ -76,7 +76,8 @@ (define generic-chord-name-properties (cons "Chord_name" (list (list 'textScriptWordSpace number? 'word-space) - (list 'chordNameWordSpace number? 'word-space)))) + (list 'chordNameWordSpace number? 'word-space) + (list 'chordNameStyle string? 'style)))) (define generic-crescendo-properties (cons "Crescendo" (list diff --git a/stepmake/stepmake/generic-targets.make b/stepmake/stepmake/generic-targets.make index 9b118581e2..2c812c8ceb 100644 --- a/stepmake/stepmake/generic-targets.make +++ b/stepmake/stepmake/generic-targets.make @@ -105,7 +105,7 @@ local-dist: $(DIST_FILES) $(OUT_DIST_FILES) $(NON_ESSENTIAL_DIST_FILES) esac case "$(OUT_DIST_FILES)x" in x) ;; *) \ - mkdir $(distdir)/$(localdir)/out; \ + mkdir -p $(distdir)/$(localdir)/out; \ $(LN) $(OUT_DIST_FILES) $(distdir)/$(localdir)/out;; \ esac # $(foreach i, $(SUBDIRS), $(MAKE) distdir=../$(distdir) localdir=$(localdir)/$(i) -C $(i) local-dist &&) true diff --git a/stepmake/stepmake/metafont-rules.make b/stepmake/stepmake/metafont-rules.make index 54b858c2f5..01feec1d1b 100644 --- a/stepmake/stepmake/metafont-rules.make +++ b/stepmake/stepmake/metafont-rules.make @@ -20,8 +20,8 @@ $(outdir)/%.tfm $(outdir)%.log: %.mf $(outdir)/%.$(XPM_RESOLUTION)gf: %.mf $(METAFONT) "\\mode=$(XPM_MODE); \\input $<" - mv $(@F) out - rm -f $(basename $(@F)).tfm $(basename $(@F)).*log +# Let's keep this log output, it saves another mf run. + mv $(@F) $(basename $(@F)).log $(basename $(@F)).tfm $(outdir) $(outdir)/%.$(XPM_RESOLUTION)pk: $(outdir)/%.$(XPM_RESOLUTION)gf gftopk $< $@ diff --git a/stepmake/stepmake/metafont-targets.make b/stepmake/stepmake/metafont-targets.make index 5f142738b9..5dffa45820 100644 --- a/stepmake/stepmake/metafont-targets.make +++ b/stepmake/stepmake/metafont-targets.make @@ -7,4 +7,4 @@ dvi: $(DVI_FILES) pks: $(addprefix $(outdir)/, $(XPM_FONTS:%=%.$(XPM_RESOLUTION)pk)) xpms: $(addprefix $(outdir)/, $(XPM_FONTS:%=%.afm)) pks - $(SHELL) $(depth)/buildscripts/mf-to-xpms.sh $(XPM_FONTS) + $(foreach i, $(XPM_FONTS), $(SHELL) $(depth)/buildscripts/mf-to-xpms.sh $(i) && ) true -- 2.39.2