From 720c52ff5a022a6e28189d8d1126d22443c313b2 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Mon, 8 May 2000 10:48:49 +0200 Subject: [PATCH] release: 1.3.48 =========== * Corrected glossary.tely * Corrected \mark font handling. feta-nummer font only of the string is all numeric. * Implemented noteHeadStyle lookup in Guile. Reintroduced the style "harmonic" and added "baroque" (normal note shapes except for brevis and longa which are square). 1.3.47. --- CHANGES | 21 +- Documentation/topdocs/index.tely | 4 +- Documentation/user/glossary.tely | 135 ++++++------ VERSION | 4 +- input/bugs/cm.ly | 26 +++ input/bugs/repbar.ly | 37 ++++ lily/chord-name.cc | 356 +++++++++++++++++++++++-------- lily/chord.cc | 74 ++++++- lily/include/chord-name.hh | 13 ++ lily/include/chord.hh | 1 + lily/misc.cc | 1 + lily/parser.yy | 2 +- make/out/lilypond.lsm | 8 +- make/out/lilypond.spec | 4 +- scm/chord-names.scm | 353 ++++-------------------------- scm/generic-property.scm | 3 +- 16 files changed, 547 insertions(+), 495 deletions(-) create mode 100644 input/bugs/cm.ly create mode 100644 input/bugs/repbar.ly diff --git a/CHANGES b/CHANGES index 78cb362076..f9de694dfb 100644 --- a/CHANGES +++ b/CHANGES @@ -1,14 +1,4 @@ ---- ../lilypond-1.3.47.jcn2/CHANGES Wed May 3 09:20:44 2000 -++ b/CHANGES Mon May 8 21:10:30 2000 -@@ -1,5 +1,7 @@ --1.3.47.jcn2 -1.3.47.jcn3 - =========== - -* Rewrite of chord-name production in scheme. - - 1.3.47.mb3 - ===========1.3.47.mb2 +1.3.47.mb2 =========== * Corrected glossary.tely @@ -28,6 +18,13 @@ * Improved heuristic size calculation of TeX macros. Handles e.g. "\\u{a}", "\\"{o}" and "\\^{u}" correctly. +1.3.47.hwn1 +=========== + +* Bugfix: don't hang on zero-duration. + +1.3.47 +====== 1.3.46.jcn2 =========== @@ -40,7 +37,7 @@ * Added Bar_number_engraver to standard Score context * Construct octavation scripts in the clef-engraver; this fixes the -hara + clef8 problem +hara-kiri + clef8 problem 1.3.46 ====== diff --git a/Documentation/topdocs/index.tely b/Documentation/topdocs/index.tely index 326173916e..a989d8ad21 100644 --- a/Documentation/topdocs/index.tely +++ b/Documentation/topdocs/index.tely @@ -100,7 +100,9 @@ Sankey}, harpsichordist to the internet, is typesetting the complete by Scarlatti}. Jeff Covey, guitar player and overall nice guy, is putting @uref{http://www4.smart.net/~jcovey/scores/,guitar music} on the net. The @uref{http://sca.uwaterloo.ca/Mutopia/,Mutopia project} is a -large archive of public domain sheet music under construction. +large archive of public domain sheet music under construction. Dirk +Latterman also put some works on the web @html diff --git a/Documentation/user/glossary.tely b/Documentation/user/glossary.tely index 65b8be9ad4..7d7d5bbe01 100644 --- a/Documentation/user/glossary.tely +++ b/Documentation/user/glossary.tely @@ -71,31 +71,31 @@ accidental. g!1_"natural" s2 } @end mudela +@item accelerando +I: accelerando, F: accelerando, en acc@'el@'erant, D: accelerando, Schneller, +NL: accelerando, DK: accelerando, S: accelerando, N: + +Still faster tempo. + @item adagio -I: adagio, F: , D: Adagio, Langsam, NL: adagio, DK: adagio, S: adagio, N: -adagio. +I: adagio, F: adagio, lent, D: Adagio, Langsam, NL: adagio, DK: adagio, S: +adagio, N: adagio. It. comfortable, easy. 1. Slow tempo, slower - especially in even meter - than @w{@ar{}@strong{andante}} and faster than @w{@ar{}@strong{largo}}. 2. A movement in slow tempo, esepecially the scond (slow) movement of @w{@ar{}@strong{sonata}s}, symphonies etc. -@item accelerando -I: accelerando, F: , D: accelerando, Schneller, NL: accelerando, DK: -accelerando, S: accelerando, N: - -Still faster tempo. - @item allegro -I: allegro, F: , D: Allegro, Schnell, Fr@"ohlich, Lustig, NL: allegro, DK: -allegro, S: allegro, N: allegro. +I: allegro, F: allegro, D: Allegro, Schnell, Fr@"ohlich, Lustig, NL: allegro, +DK: allegro, S: allegro, N: allegro. It. cheerful. Quick tempo. Also used as a title for pieces in a quick tempo, especially the first and last movements of a @w{@ar{}@strong{sonata}}. @item alto -I: contralto, F: alto, D: Alt, NL: alt, DK: alt, S: alt, N: alt. +I: contralto, F: alto, D: Alt, NL: alt, DK: alt, S: alt, N: alt. A female voice of low range (@emph{contralto}). Originally the alto was a high male voice (hence the name) which by the use of falsetto reached the height of @@ -103,8 +103,8 @@ the female voice. This type of voice is also known as @w{@ar{}@strong{counter tenor}}. @item alto clef -I: chiave di contralto, F: , D: Altschl@"ussel, Bratschenschl@"ussel, NL: alt -sleutel, DK: altn@o{}gle, S: altklav, N: +I: chiave di contralto, F: clef d'ut troisi@`eme ligne, D: Altschl@"ussel, +Bratschenschl@"ussel, NL: alt sleutel, DK: altn@o{}gle, S: altklav, N: C clef setting central C on the middle line of the staff @w{@ar{}@strong{C clef}} @@ -217,8 +217,8 @@ Intervall, NL: overmatig interval, DK: forst@o{}rret interval, S: @w{@ar{}@strong{interval}} @item autograph -I: autografo, F: , D: Autograph, Handschrift, NL: , DK: h@aa{}ndskrift, -autograf, S: handskrift, N: . +I: autografo, F: manuscrit, D: Autograph, Handschrift, NL: manuscript, DK: +h@aa{}ndskrift, autograf, S: handskrift, N: . 1. A manuscript in the composer's own hand. 2. Music prepared for photoreproduction by freehand drawing, with only the aid of a @@ -246,15 +246,16 @@ The male voice intermediate between the @w{@ar{}@strong{bass}} and the @w{@ar{}@strong{tenor}}. @item baritone clef -I: chiave di baritono, F: , D: Barytonschl@"ussel, NL: baritonsleutel, DK: -barytonn@o{}gle, S: barytonklav, N: . +I: chiave di baritono, F: clef de ut cinqui@`eme ligne, clef de troisi@`eme +ligne, D: Barytonschl@"ussel, NL: baritonsleutel, DK: barytonn@o{}gle, S: +barytonklav, N: . C or F clef setting central C on the upper staff line. @w{@ar{}@strong{c clef}} @w{@ar{}@strong{f clef}} @item bass clef -I: chiave di basso, F: cl@'e de fa, D: Bass-Schl@"ussel, NL: bassleutel, DK: -basn@o{}gle, S: basklav, N: +I: chiave di basso, F: cl@'e de fa quatri@`eme ligne, D: Bass-Schl@"ussel, NL: +bassleutel, DK: basn@o{}gle, S: basklav, N: A clef setting with central C on the first top ledger line. @w{@ar{}@strong{f clef}} @@ -325,8 +326,8 @@ orchestral or choral score. @ @mudela[13pt,eps] -\context StaffGroup < -% \context ChoirStaff < +%\context StaffGroup < +\context ChoirStaff < \property StaffGroup.minVerticalAlign = 12 \notes\relative c'' { \clef treble; g4 e c2 } \notes\relative c { \clef bass; c1 \bar "|."; } > @@ -405,12 +406,12 @@ the middle of the 19'th century, however, most cadences have been written down by the composer. @item canon -I: canone, F: , D: Kanon, NL: canon, DK: kanon, S: kanon, N: . +I: canone, F: canon, D: Kanon, NL: canon, DK: kanon, S: kanon, N: . @w{@ar{}@strong{counterpoint}} @item cent -I: cent, F: , D: Cent, NL: cent, DK: cent, S: cent, N: . +I: cent, F: cent, D: Cent, NL: cent, DK: cent, S: cent, N: . Logarithmic unit of measurement. 1 cent is 1/1200 of an octave (1/100 of an equally tempered @w{@ar{}@strong{semitone}}) @w{@ar{}@strong{equal temperament}} @@ -461,8 +462,8 @@ A scale consisting of all 11 @w{@ar{}@strong{semitone}}s. @end mudela @item chromaticism -I: cromatismo, F: , D: Chromatik, NL: chromatiek, DK: kromatik, S: kromatik, -N: +I: cromatismo, F: chromatisme, D: Chromatik, NL: chromatiek, DK: kromatik, S: +kromatik, N: Use of tones extraneous to a @w{@ar{}@strong{diatonic scale}} (minor, major). @@ -496,14 +497,15 @@ Intervals larger than an octave @w{@ar{}@strong{interval}} @item complement -I: rivolto, F: , D: Komplement@"arintervall, NL: complementair interval, DK: -komplement@ae{}rinterval, S: komplement@"arintervall (?), N: +I: rivolto, F: intervalle compl@'ementaire, D: Komplement@"arintervall, NL: +complementair interval, DK: komplement@ae{}rinterval, S: +komplement@"arintervall (?), N: @w{@ar{}@strong{inverted interval}} @item conjunct movement -I: moto congiunto, F: mouvement conjoint, D: enge Lage(?), NL: , DK: trinvis -bev@ae{}gelse, S: stegvis r@"orelse, N: +I: moto congiunto, F: mouvement conjoint, D: schrittweise/stufenweise +Bewegung, NL: , DK: trinvis bev@ae{}gelse, S: stegvis r@"orelse, N: Melody moving in the narrow steps of the scale; @@ -604,8 +606,8 @@ abbreviation "cresc.". @end mudela @item cue-notes -I: notine, F: , D: Stichnoten, NL: stichnoten, DK: stiknoder, S: -inprickningar, N: +I: notine, F: petites notes pr@'ec@'edent l'entr@'ee d'in instrument, +r@'eplique, D: Stichnoten, NL: stichnoten, DK: stiknoder, S: inprickningar, N: In a separate part notes belonging to another part with the purpose of hinting when to start playing. Usually printed in a smaller type. @@ -613,16 +615,16 @@ when to start playing. Usually printed in a smaller type. @item D I: re, F: r@'e, D: D, d, NL: d, DK: d, S: d, N: d -@item da capo -I: da capo, F: , D: da capo, von Anfang, NL: da capo, DK: da capo, S: da capo, -N: . +@item da capo +I: da capo, F: da capo, depuis le commencement, D: da capo, von Anfang, NL: da +capo, DK: da capo, S: da capo, N: . The term indicates repetition of the piece from the beginning to the end or to a certain place marked @emph{fine}. Mostly abbreviated D.C. @item dal segno -I: dal segno, F: , D: dal segno, NL: dal segno, DK: dal segno, S: dal -segno, N: . +I: dal segno, F: dal segno, depuis le signe, D: dal segno, NL: dal segno, DK: +dal segno, S: dal segno, N: . abbreviated d.s. Repetition, not from the beginning, but from another place frequently near the beginning marked by a sign: @@ -848,8 +850,9 @@ S:@w{ }diminuendo, N:@w{ }diminuendo. @w{@ar{}@strong{decrescendo}} @item disjunct movement -I: moto disgiunto, F: mouvement disjoint, D: , NL: , DK: springende -bev@ae{}gelse, S: spr@aa{}ngvis r@"orelse, N: +I: moto disgiunto, F: mouvement disjoint, D: +sprunghafte Bewegung, NL: , DK: springende bev@ae{}gelse, S: hoppande +r@"orelse, N: Melody moving in steps greater than those of the scale. Opposite of @ar{}@strong{conjunct movement}. @@ -1088,7 +1091,8 @@ a4 b c2^\fermata \bar "|."; } @end mudela @item fifth -I: quinta, F: quinte, D: Quinte, NL: kwint, I: , DK: kvint, S: kvint, N: kvint. +I: quinta, F: quinte, D: Quinte, NL: kwint, DK: kvint, S: kvint, N: +kvint. @w{@ar{}@strong{interval}} @@ -1146,8 +1150,8 @@ I: fuga, F: fugue, D: Fuge, NL: fuga, DK: fuga, S: fuga, N: . @w{@ar{}@strong{counterpoint}} @item functional harmony -I: armonia funzionale, F: , D: Funktionslehre, NL: , DK: funktionsanalyse, -funktionsharmonik, S: funktionsl@"ara, N: +I: armonia funzionale, F: @'etude des functions, D: Funktionslehre, NL: , DK: +funktionsanalyse, funktionsharmonik, S: funktionsl@"ara, N: A system of harmonic analysis. It is based on the idea that, in a given key, there are only three functionally different chords: tonic (T, the chord on the @@ -1214,9 +1218,8 @@ glissando, N: glissando. Letting the pitch slide fluently from one note to the other @item grace notes -I: abbellimenti, F: fioriture, petite[s] note[s], D: Verzierungen, -Vorschl@"age, Vorschlagsnoten, NL: versieringen, DK: forsiringer, S: ornament, -N: . +I: abbellimenti, F: fioriture, D: Verzierungen, Vorschl@"age, Vorschlagsnoten, +NL: versieringen, DK: forsiringer, S: ornament, N: . Notes printed in small types to indicate that their time values are not counted in the rhythm of the bar. @w{@ar{}@strong{appoggiatura}} @@ -1230,7 +1233,7 @@ S: ackolad, b@"ojd klammer, N: . A combination of two staffs with a brace. Usually used for piano music. @item grave -I: grave, F: grave, D: grave, langsam, traurig, NL: , DK: grave, S: grave, N: +I: grave, F: grave, D: grave, langsam, traurig, NL: grave, ernstig, DK: grave, S: grave, N: . Slow, solemn. @@ -1411,8 +1414,8 @@ The difference between an interval and an octave. @end mudela @item just intonation -I: intonazione giusta, F: , D: reine Stimmung, NL: reine stemming, DK: ren -stemning, S: ren st@"amning, N: . +I: intonazione giusta, F: intonation juste, D: reine Stimmung, NL: reine +stemming, DK: ren stemning, S: ren st@"amning, N: . Tuning system in which the notes are obtained by adding and subtracting @w{natural} fifths and thirds. @w{@ar{}@strong{temperament}} @@ -1740,8 +1743,8 @@ and @w{@ar{}@strong{note}} is strongly recommended. Briefly, one sees a note, and hears a tone. @item note head -I: testa, F: , D: Notenkopf, NL: nootballetje, DK: nodehovede, S: nothuvud, N: -. +I: testa, testina, capocchia, F: t@^ete de la note, D: Notenkopf, NL: +nootballetje, DK: nodehovede, S: nothuvud, N: . A head like sign which indicates pitch by its position on a @w{@ar{}@strong{staff}} provided with a @w{@ar{}@strong{clef}}, and duration @@ -2188,8 +2191,8 @@ A slur above or below a group of notes indicates that they are to be played breath in singing. @item solmization -I: solmisazione, F: , D: Solmisation, NL: solmizatie, DK: solmisation, S: -solmisation, N: . +I: solmisazione, F: solmisation, D: Solmisation, NL: solmizatie, DK: +solmisation, S: solmisation, N: . General term for systems of designating the degrees of the @w{@ar{}@strong{scale}}, not by letters, but by syllables (@emph{do} @@ -2297,8 +2300,8 @@ The fourth @w{@ar{}@strong{scale degree}}. @w{@ar{}@strong{functional harmony}} @item submediant -I: sopratonica, F: , D: Submediant, NL: submediant, DK: Submediant, S: -submediant, N: . +I: sopratonica, F: sous-m@'ediante, D: Submediant, NL: submediant, DK: +Submediant, S: submediant, N: . The sixth @w{@ar{}@strong{scale degree}}. @@ -2400,9 +2403,8 @@ I: terza, F: tierce, D: Terz, NL: terts, DK: terts, S: ters, N: . @item thirty-second note I: biscroma, F: triple croche, UK: demisemiquaver, D: -Zweiunddrei@ss{}igstel, Zweiunddrei@ss{}igstelnote, NL: -twee-endertigste noot, DK: toogtredivtedelsnode, S: -trettiotv@aa{}ondelsnot, N: . +Zweiunddrei@ss{}igstel, Zweiunddrei@ss{}igstelnote, NL: twee-endertig@-ste +noot, DK: toogtredivtedelsnode, S: trettiotv@aa{}ondelsnot, N: . @w{@ar{}@strong{note value}} @@ -2533,12 +2535,15 @@ a @w{@ar{}@strong{chord}}, usually in the distance of a third \property Score.barNonAuto = ##t \property Voice.textStyle = "large" \notes\relative c' { - e2:32_"a" f:32 [ e8:16 f:16 g:16 a:16 ] s4 \repeat "tremolo" 16 { e32_"b" g } -} + % e2:32_"a" f:32 [ e8:16 f:16 g:16 a:16 ] s4 [:32 e1_"b" g] + % e2:32_"a" f:32 [ e8:16 f:16 g:16 a:16 ] s4 \repeat "tremolo" 16 { e32_"b" g } + e2:32_"a" f:32 [ e8:16 f:16 g:16 a:16 ] s4 \repeat "tremolo" 8 { e32_"b" g } +} @end mudela @item triad -I: triade, F: , D: Dreiklang, NL: drieklank, DK: treklang, S: treklang, N: +I: triade, F: triade, accord parfait, accord de trois sons, D: Dreiklang, NL: +drieklank, DK: treklang, S: treklang, N: @w{@ar{}@strong{chord}} @@ -2585,7 +2590,7 @@ or by the whole orchestra (choir), either at exactly the same pitch or in a different octave. @item upbeat -I: anacrusi, F: anacrouse, D: Auftakt, NL: opmaat, I: , DK: optakt, S: +I: anacrusi, F: anacrouse, D: Auftakt, NL: opmaat, DK: optakt, S: upptakt, N: Initial note(s) of a melody occurring before the first bar @@ -2636,8 +2641,8 @@ tones on the piano keyboard with exactly one key between them - including black and white keys - is a whole tone. @item woodwind -I: legni, F: , D: Holzbl@"aser, NL: houtblazers, DK tr@ae{}bl@ae{}sere, S: -tr@"abl@aa{}sare, N: . +I: legni, F: le bois, D: Holzbl@"aser, NL: houtblazers, DK tr@ae{}bl@ae{}sere, +S: tr@"abl@aa{}sare, N: . A family of blown wooden musical instruments. Today some of these instruments are actually made from metal. The woodwind instruments commonly used in a @@ -2695,8 +2700,8 @@ achtste @tab ottende@-del @tab @aa{}tton@-del @tab @item @item @strong{thirty-second} @tab demi@-semi@-quaver @tab bis@-croma @tab -triple croche @tab Zwei@-und@-drei@-@ss{}ig@-stel @tab 32e @tab -toog@-tredivte-del @tab trettio@-tv@aa{}on@-del @tab +triple croche @tab Zwei@-und@-drei@-@ss{}ig@-stel @tab twee-en@-dertig@-ste +@tab toog@-tredivte-del @tab trettio@-tv@aa{}on@-del @tab @item @@ -2787,6 +2792,8 @@ quotes from its articles have been included into the item explanation texts. Hugo Riemans Musiklexicon, Berlin 1929 + +Polyglottes W@"orterbuch der musikalisch Terminologie, Kassel 1980 Oxford Advanced Learner's Dictionary of Current English, Third Edition 1974. @end table diff --git a/VERSION b/VERSION index 7160434da2..e81a8b6f4c 100644 --- a/VERSION +++ b/VERSION @@ -1,8 +1,8 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=3 -PATCH_LEVEL=47 -MY_PATCH_LEVEL=jcn3 +PATCH_LEVEL=48 +MY_PATCH_LEVEL= # use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/input/bugs/cm.ly b/input/bugs/cm.ly new file mode 100644 index 0000000000..02e832028f --- /dev/null +++ b/input/bugs/cm.ly @@ -0,0 +1,26 @@ +flauti = \notes \relative c' { + c1 + \break c +} + + +timpani = \notes \relative c' { + c1 c +} + + + +\score { + < + \context StaffGroup ="legni" < + \context Staff ="flauti" \flauti + > + \context StaffGroup ="timpani" < + \notes { + c1 + } + > + > + +} + diff --git a/input/bugs/repbar.ly b/input/bugs/repbar.ly new file mode 100644 index 0000000000..f51ae90b81 --- /dev/null +++ b/input/bugs/repbar.ly @@ -0,0 +1,37 @@ +foo = \notes { \context Voice { \relative c'' { +\repeat volta 3 { e c d e } \break +\repeat volta 3 { e c d e } +} +} +} +\score { +\context PianoStaff < +\context Staff = one \foo +\context Staff = two \foo +> +\midi{} +\paper{} +} +foo = \notes { \context Voice { \relative c'' { +\repeat volta 3 { e c d e } \break +\repeat volta 3 { e c d e } +} +} +} +\score { +\context PianoStaff < +\context Staff = one \foo +\context Staff = two \foo +> + \paper { linewidth = 17.0\cm; + \translator { + \OrchestralScoreContext + minVerticalAlign = 2.5*\staffheight; + } + \translator { + \StaffContext + \consists Instrument_name_engraver; + } + } +\midi{} +} diff --git a/lily/chord-name.cc b/lily/chord-name.cc index bb6fbbc1ea..75a16226c9 100644 --- a/lily/chord-name.cc +++ b/lily/chord-name.cc @@ -26,126 +26,298 @@ ("style" . "text") */ Molecule -Chord_name::ly_word2molecule (SCM word) const +Chord_name::ly_word2molecule (SCM scm) const { - Dictionary option_dict; - if (gh_pair_p (word)) + String style; + if (gh_pair_p (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; + SCM s = gh_car (scm); + if (gh_string_p (s)) + style = ly_scm2string (s); + scm = gh_cdr (scm); } + if (gh_string_p (scm)) + return lookup_l ()->text (style, ly_scm2string (scm), paper_l ()); return Molecule (); } /* - ;; text: list of word - ;; word: string + optional list of property - ;; property: align, kern, font (?), size + scm is word or list of words: + word + (word word) */ Molecule -Chord_name::ly_text2molecule (SCM text) const +Chord_name::ly_text2molecule (SCM scm) const { Molecule mol; - if (gh_list_p (text)) + if (gh_list_p (scm)) { - while (gh_cdr (text) != SCM_EOL) + while (gh_cdr (scm) != SCM_EOL) { - Molecule m = ly_word2molecule (gh_car (text)); + Molecule m = ly_word2molecule (gh_car (scm)); if (!m.empty_b ()) mol.add_at_edge (X_AXIS, RIGHT, m, 0); - text = gh_cdr (text); + scm = gh_cdr (scm); } - text = gh_car (text); + scm = gh_car (scm); } - Molecule m = ly_word2molecule (text); + Molecule m = ly_word2molecule (scm); 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 { - SCM style = get_elt_property ("style"); - if (style == SCM_UNDEFINED) - style = ly_str02scm ("banter"); + 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 inversion = get_elt_property ("inversion"); - if (inversion == SCM_UNDEFINED) - inversion = SCM_BOOL_F; + SCM s = get_elt_property ("inversion"); + if (s != SCM_UNDEFINED) + { + name.inversion_mol = lookup_l ()->text ("", "/", paper_l ()); + Musical_pitch p (s); - SCM bass = get_elt_property ("bass"); - if (bass == SCM_UNDEFINED) - bass = SCM_BOOL_F; + Molecule mol = pitch2molecule (p); + name.inversion_mol.add_at_edge (X_AXIS, RIGHT, mol, 0); + } - SCM pitches = get_elt_property ("pitches"); + 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); + } - 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)); + // 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); - return ly_text2molecule (text); + 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 (); + + return mol; } diff --git a/lily/chord.cc b/lily/chord.cc index 8a524f0110..e188062f0e 100644 --- a/lily/chord.cc +++ b/lily/chord.cc @@ -295,10 +295,6 @@ 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) { @@ -381,6 +377,76 @@ 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 3bdf747a0b..fa9cba3a87 100644 --- a/lily/include/chord-name.hh +++ b/lily/include/chord-name.hh @@ -13,6 +13,16 @@ #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 @@ -25,6 +35,9 @@ 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 ce85501bf8..2d13e75deb 100644 --- a/lily/include/chord.hh +++ b/lily/include/chord.hh @@ -22,6 +22,7 @@ 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/misc.cc b/lily/misc.cc index 8523cddd86..8597a8ce14 100644 --- a/lily/misc.cc +++ b/lily/misc.cc @@ -13,6 +13,7 @@ int intlog2(int d) { + assert (d); int i=0; while (!(d&1)) { diff --git a/lily/parser.yy b/lily/parser.yy index e5a7583522..3c0320699b 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -45,7 +45,7 @@ bool is_duration_b (int t) { - return t == 1 << intlog2(t); + return t && t == 1 << intlog2(t); } diff --git a/make/out/lilypond.lsm b/make/out/lilypond.lsm index 0d565db6aa..4fbde8dde5 100644 --- a/make/out/lilypond.lsm +++ b/make/out/lilypond.lsm @@ -1,15 +1,15 @@ Begin3 Title: LilyPond -Version: 1.3.47 -Entered-date: 27APR00 +Version: 1.3.48 +Entered-date: 08MAY00 Description: Keywords: music notation typesetting midi fonts engraving Author: hanwen@cs.uu.nl (Han-Wen Nienhuys) janneke@gnu.org (Jan Nieuwenhuizen) Maintained-by: hanwen@stack.nl (Han-Wen Nienhuys) Primary-site: sunsite.unc.edu /pub/Linux/apps/sound/convert - 1000k lilypond-1.3.47.tar.gz + 1000k lilypond-1.3.48.tar.gz Original-site: ftp.cs.uu.nl /pub/GNU/LilyPond/development/ - 1000k lilypond-1.3.47.tar.gz + 1000k lilypond-1.3.48.tar.gz Copying-policy: GPL End diff --git a/make/out/lilypond.spec b/make/out/lilypond.spec index cb451a8406..0d1645f4f4 100644 --- a/make/out/lilypond.spec +++ b/make/out/lilypond.spec @@ -1,9 +1,9 @@ Name: lilypond -Version: 1.3.47 +Version: 1.3.48 Release: 1 Copyright: GPL Group: Applications/Publishing -Source0: ftp.cs.uu.nl:/pub/GNU/LilyPond/development/lilypond-1.3.47.tar.gz +Source0: ftp.cs.uu.nl:/pub/GNU/LilyPond/development/lilypond-1.3.48.tar.gz Summary: A program for printing sheet music. URL: http://www.cs.uu.nl/~hanwen/lilypond # Icon: lilypond-icon.gif diff --git a/scm/chord-names.scm b/scm/chord-names.scm index e6d72a9059..7a8777fbc7 100644 --- a/scm/chord-names.scm +++ b/scm/chord-names.scm @@ -1,325 +1,56 @@ -;;; chord.scm -- to be included in/to replace chord-name.scm -;;; 2000 janneke@gnu.org -;;; +;; note-name: (note . accidental) +;; list: (list-of-pitches . (modifier-string . addition-subtraction-string)) -(use-modules - (ice-9 debug)) +;; if a complete chord is found, use name +;; if a chord's base triad is found (c e g), use name -;; -;; (octave notename accidental) -;; - -;; -;; text: list of word -;; word: string + optional list of property -;; property: size, style, font, super, offset -;; - -;; TODO -;; -;; * clean split of base/banter/american stuff -;; * text definition is rather ad-hoc. -;; * finish and check american names -;; * make notename (tonic) configurable from mudela -;; * fix append/cons stuff in inner-name-banter -;; +(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)) +(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)))) -;;;;;;;;; -(define chord::names-alist-banter '()) -(set! chord::names-alist-banter +(define chord-names-alist '()) +(set! chord-names-alist (append - '( + '( ; C iso C.no3.no5 - (((0 . 0)) . #f) + (((0 . 0)) . (#f . #f)) ; C iso C.no5 - (((0 . 0) (2 . 0)) . #f) + (((0 . 0) (2 . 0)) . (#f . #f)) ; Cm iso Cm.no5 - (((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")))) + (((0 . 0) (2 . -1)) . ("m" . #f)) ; Cdim iso Cm5- - (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) + (((0 . 0) (2 . -1) (4 . -1)) . ("dim" . #f)) ; Co iso Cm5-7- ; urg - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("o" (type . "super")))) + ; (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" . ("feta-1" . "."))) + (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (#f . ("script" . "o"))) ; Cdim9 - (((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")))) + (((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"))) ) - 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 0 -1 -1))) -(define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0))) - -(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))))) - -(define (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion) - (apply append (pitch->text-banter tonic) - (if user-name user-name '()) - (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))) - -(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))) - -(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)))))) + chord-names-alist)) +(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 1506982fb6..3145084cc7 100644 --- a/scm/generic-property.scm +++ b/scm/generic-property.scm @@ -76,8 +76,7 @@ (define generic-chord-name-properties (cons "Chord_name" (list (list 'textScriptWordSpace number? 'word-space) - (list 'chordNameWordSpace number? 'word-space) - (list 'chordNameStyle string? 'style)))) + (list 'chordNameWordSpace number? 'word-space)))) (define generic-crescendo-properties (cons "Crescendo" (list -- 2.39.5