From: Jan Nieuwenhuizen Date: Thu, 16 Nov 2000 11:55:42 +0000 (+0100) Subject: patch::: 1.3.108.jcn2 X-Git-Tag: release/1.3.109~4 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=0d4a3f8b85484d352a128ace42efd297dbb1bc37;p=lilypond.git patch::: 1.3.108.jcn2 1.3.108.jcn2 --- diff --git a/CHANGES b/CHANGES index 6bf299a1b9..ed137253f1 100644 --- a/CHANGES +++ b/CHANGES @@ -1,7 +1,7 @@ -1.3.107.jcn5 +1.3.108.jcn2 ============ -* Removed some hair from chord.cc +* Removed some hair from chord code. 1.3.107.jcn3 ============ diff --git a/VERSION b/VERSION index f6d615bcb6..53df617040 100644 --- a/VERSION +++ b/VERSION @@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond MAJOR_VERSION=1 MINOR_VERSION=3 PATCH_LEVEL=108 -MY_PATCH_LEVEL=jcn1 +MY_PATCH_LEVEL=jcn2 # use the above to send patches: MY_PATCH_LEVEL is always empty for a # released version. diff --git a/lily/chord-name-engraver.cc b/lily/chord-name-engraver.cc index 877d7c988c..b9328b5113 100644 --- a/lily/chord-name-engraver.cc +++ b/lily/chord-name-engraver.cc @@ -29,20 +29,14 @@ protected: virtual void do_pre_move_processing (); virtual void acknowledge_element (Score_element_info i); virtual void do_process_music (); - virtual bool do_try_music (Music* m); + virtual bool do_try_music (Music *); private: - void create_chord_name (); + void add_note (Note_req *); Item* chord_name_p_; - Protected_scm pitches_; - Protected_scm chord_; Protected_scm last_chord_; - - Protected_scm tonic_req_; - Protected_scm inversion_req_; - Protected_scm bass_req_; }; ADD_THIS_TRANSLATOR (Chord_name_engraver); @@ -50,19 +44,26 @@ ADD_THIS_TRANSLATOR (Chord_name_engraver); Chord_name_engraver::Chord_name_engraver () { chord_name_p_ = 0; - pitches_ = SCM_EOL; - tonic_req_ = SCM_EOL; - inversion_req_ = SCM_EOL; - bass_req_ = SCM_EOL; - chord_ = SCM_EOL; - last_chord_ = SCM_EOL; + chord_ = gh_cons (SCM_EOL, gh_cons (SCM_EOL, SCM_EOL)); + last_chord_ = gh_cons (SCM_EOL, gh_cons (SCM_EOL, SCM_EOL)); } void -Chord_name_engraver::acknowledge_element (Score_element_info i) +Chord_name_engraver::add_note (Note_req* n) { - if (Note_req* n = dynamic_cast (i.req_l_)) - pitches_ = gh_cons (n->get_mus_property ("pitch"), pitches_); + SCM pitches = gh_car (chord_); + SCM modifiers = gh_cdr (chord_); + SCM inversion = modifiers == SCM_EOL ? SCM_EOL : gh_car (modifiers); + SCM bass = modifiers == SCM_EOL ? SCM_EOL : gh_cdr (modifiers); + + if (n->get_mus_property ("inversion") == SCM_BOOL_T) + inversion = n->get_mus_property ("pitch"); + else if (n->get_mus_property ("bass") == SCM_BOOL_T) + bass = n->get_mus_property ("pitch"); + else + pitches = scm_sort_list (gh_cons (n->get_mus_property ("pitch"), pitches), + Pitch::less_p_proc); + chord_ = gh_cons (pitches, gh_cons (inversion, bass)); } bool @@ -70,44 +71,57 @@ Chord_name_engraver::do_try_music (Music* m) { if (Note_req* n = dynamic_cast (m)) { - pitches_ = gh_cons (n->get_mus_property ("pitch"), pitches_); - return true; - } - if (Tonic_req* t = dynamic_cast (m)) - { - tonic_req_ = t->get_mus_property ("pitch"); - return true; - } - if (Inversion_req* i = dynamic_cast (m)) - { - inversion_req_ = i->get_mus_property ("pitch"); - return true; - } - if (Bass_req* b = dynamic_cast (m)) - { - bass_req_ = b->get_mus_property ("pitch"); + add_note (n); return true; } return false; } +/* Uh, if we do acknowledge_element, shouldn't we postpone + do_process_music until do_process_acknowlegded? + + Sigh, I can *never* remember how this works, can't we + possibly-please just number these functions: + + do_creation0 + + post_move1 + do_try_music2 + do_process_music3 (or is it acknowledge_element3 ?) + acknowledge_element4 + + do_pre_move9 + + do_removal99 + + and what was the deal with this ``do'' prefix again? */ +void +Chord_name_engraver::acknowledge_element (Score_element_info i) +{ + if (Note_req* n = dynamic_cast (i.req_l_)) + add_note (n); +} + void Chord_name_engraver::do_process_music () { - if (!chord_name_p_ && pitches_ != SCM_EOL) + if (!chord_name_p_ && gh_car (chord_) != SCM_EOL) { +#if 0 bool find_inversion_b = false; SCM chord_inversion = get_property ("chordInversion"); if (gh_boolean_p (chord_inversion)) find_inversion_b = gh_scm2bool (chord_inversion); chord_ = Chord::pitches_and_requests_to_chord (pitches_, - tonic_req_, - inversion_req_, - bass_req_, + inversion_, + bass_, find_inversion_b); + +#endif - create_chord_name (); + chord_name_p_ = new Item (get_property ("ChordName")); + chord_name_p_->set_elt_property ("chord", chord_); announce_element (chord_name_p_, 0); SCM s = get_property ("drarnChords"); //FIXME! if (to_boolean (s) && last_chord_ != SCM_EOL && @@ -116,21 +130,6 @@ Chord_name_engraver::do_process_music () } } -void -Chord_name_engraver::create_chord_name () -{ - chord_name_p_ = new Item (get_property ("ChordName")); - - SCM pitches = gh_car (chord_); - SCM modifiers = gh_cdr (chord_); - SCM inversion = gh_car (modifiers); - SCM bass = gh_cdr (modifiers); - /* Hmm, maybe chord-name should use (pitches (inversion . base)) too? */ - chord_name_p_->set_elt_property ("pitches", pitches); - chord_name_p_->set_elt_property ("inversion", inversion); - chord_name_p_->set_elt_property ("inversion", bass); -} - void Chord_name_engraver::do_pre_move_processing () { @@ -140,11 +139,7 @@ Chord_name_engraver::do_pre_move_processing () } chord_name_p_ = 0; - pitches_ = SCM_EOL; - tonic_req_ = SCM_EOL; - inversion_req_ = SCM_EOL; - bass_req_ = SCM_EOL; last_chord_ = chord_; - chord_ = SCM_EOL; + chord_ = gh_cons (SCM_EOL, gh_cons (SCM_EOL, SCM_EOL)); } diff --git a/lily/chord-name.cc b/lily/chord-name.cc index 163371807d..24e2ced509 100644 --- a/lily/chord-name.cc +++ b/lily/chord-name.cc @@ -48,17 +48,9 @@ Chord_name::brew_molecule (SCM smob) if (!gh_string_p (style)) style = ly_str02scm ("banter"); - SCM inversion = me-> get_elt_property ("inversion"); - if (inversion == SCM_EOL) - inversion = SCM_BOOL_F; - - SCM bass = me->get_elt_property ("bass"); - if (bass == SCM_EOL) - bass = SCM_BOOL_F; - - SCM pitches = me->get_elt_property ("pitches"); + SCM chord = me-> get_elt_property ("chord"); SCM func = me->get_elt_property (ly_symbol2scm ("chord-name-function")); - SCM text = gh_call3 (func, style, pitches, gh_cons (inversion, bass)); + SCM text = gh_call2 (func, style, chord); SCM properties = Font_interface::font_alist_chain (me); Molecule mol = Text_item::text2molecule (me, text, properties); diff --git a/lily/chord.cc b/lily/chord.cc index aecc8eb45b..ad26aed4cf 100644 --- a/lily/chord.cc +++ b/lily/chord.cc @@ -78,59 +78,6 @@ ly_split_list (SCM s, SCM list) return gh_cons (gh_reverse (before), after); } - -/* Construct from list of pitches and requests: - - (PITCHES . (INVERSION . BASS)) - - - Note, the pitches here, are all inclusive. - We must identify tonic, filter-out (and maybe detect) inversion and bass. */ - -SCM -Chord::pitches_and_requests_to_chord (SCM pitches, - SCM tonic_req, - SCM inversion_req, - SCM bass_req, - bool find_inversion_b) -{ - pitches = scm_sort_list (pitches, Pitch::less_p_proc); - - if (bass_req != SCM_EOL) - { - assert (unsmob_pitch (gh_car (pitches))->notename_i_ - == unsmob_pitch (bass_req)->notename_i_); - pitches = gh_cdr (pitches); - } - - if (inversion_req != SCM_EOL) - { - assert (unsmob_pitch (gh_car (pitches))->notename_i_ - == unsmob_pitch (inversion_req)->notename_i_); - /* huh ? */ - assert (tonic_req != SCM_EOL); - - SCM tonic = member_notename (tonic_req, pitches); - if (tonic != SCM_EOL) - pitches = add_above_tonic (gh_car (pitches), gh_cdr (pitches)); - } - else if (find_inversion_b) - { - SCM tonic = (tonic_req != SCM_EOL) - ? member_notename (pitches, tonic_req) - : guess_tonic (pitches); - - if (tonic != SCM_EOL) - pitches = add_above_tonic (gh_car (pitches), gh_cdr (pitches)); - } - - if (tonic_req != SCM_EOL) - assert (unsmob_pitch (gh_car (pitches))->notename_i_ - == unsmob_pitch (tonic_req)->notename_i_); - - return gh_cons (pitches, gh_cons (inversion_req, bass_req)); -} - /* JUNKME. do something smarter. @@ -237,23 +184,18 @@ Chord::member_pitch (SCM p, SCM pitches) return member; } - - -int -Chord::step_i (Pitch tonic, Pitch p) +SCM +Chord::step_scm (SCM tonic, SCM p) { - int i = p.notename_i_ - tonic.notename_i_ - + (p.octave_i () - tonic.octave_i () ) * 7; + /* De Pitch intervaas is nog beetje sleutelgat? */ + int i = unsmob_pitch (p)->notename_i_ + - unsmob_pitch (tonic)->notename_i_ + + (unsmob_pitch (p)->octave_i_ + - unsmob_pitch (tonic)->octave_i_ ) * 7; while (i < 0) i += 7; i++; - return i; -} - -SCM -Chord::step_scm (SCM tonic, SCM p) -{ - return gh_int2scm (step_i (*unsmob_pitch (tonic), *unsmob_pitch (p))); + return gh_int2scm (i); } /* @@ -315,60 +257,6 @@ Chord::missing_thirds (SCM pitches) return lower_step (tonic, missing, gh_int2scm (7)); } - -/* Mangle - - (PITCHES . (INVERSION . BASS)) - - into full list of pitches. - - This means: - - delete INVERSION and add as lowest note of PITCHES - - add BASS as lowest note of PITCHES */ - -SCM -Chord::to_pitches (SCM chord) -{ - SCM pitches = gh_car (chord); - SCM modifiers = gh_cdr (chord); - SCM inversion = gh_car (modifiers); - SCM bass = gh_cdr (modifiers); - - if (inversion != SCM_EOL) - { - /* If inversion requested, check first if the note is part of chord */ - SCM s = member_pitch (inversion, pitches); - if (s != SCM_BOOL_F) - { - /* Then, delete and add as base note, ie: the inversion */ - scm_delete (s, pitches); - pitches = add_below_tonic (s, pitches); - } - else - warning (_f ("invalid inversion pitch: not part of chord: %s", - unsmob_pitch (inversion)->str ())); - } - - /* Bass is easy, just add if requested */ - if (bass != SCM_EOL) - pitches = add_below_tonic (bass, pitches); - - return pitches; -} - -/* - This routine tries to guess tonic in a possibly inversed chord, ie - should produce: C. - This is only used for chords that are entered as simultaneous notes, - chords entered in \chord mode are fully defined. - */ - -SCM -Chord::guess_tonic (SCM pitches) -{ - return gh_car (scm_sort_list (pitches, Pitch::less_p_proc)); -} - /* Return PITCHES with PITCH added not as lowest note */ SCM Chord::add_above_tonic (SCM pitch, SCM pitches) @@ -399,16 +287,13 @@ Chord::add_below_tonic (SCM pitch, SCM pitches) Construct from parser output: - (PITCHES . (INVERSION . BASS)) - PITCHES is the plain chord, it does not include bass or inversion Part of Chord:: namespace for now, because we do lots of chord-manipulating stuff. */ SCM -Chord::tonic_add_sub_inversion_bass_to_scm (SCM tonic, SCM add, SCM sub, - SCM inversion, SCM bass) +Chord::tonic_add_sub_to_pitches (SCM tonic, SCM add, SCM sub) { /* urg: catch dim modifier: 3rd, 5th, 7th, .. should be lowered */ bool dim_b = false; @@ -486,66 +371,57 @@ Chord::tonic_add_sub_inversion_bass_to_scm (SCM tonic, SCM add, SCM sub, warning (_f ("invalid subtraction: not part of chord: %s", unsmob_pitch (gh_car (i))->str ())); - return gh_cons (pitches, gh_cons (inversion, bass)); + return pitches; } -/* - --Het lijkt me dat dit in het paarse gedeelte moet. - - Zo-en-zo, lijktme dat je ipv. Inversion_req een (inversion . #t) aan - de betreffende Noot_req kan hangen -*/ - +/* --Het lijkt me dat dit in het paarse gedeelte moet. */ Simultaneous_music * Chord::get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur) { - SCM chord = tonic_add_sub_inversion_bass_to_scm (tonic, add, sub, - inversion, bass); - - Tonic_req* t = new Tonic_req; - t->set_mus_property ("pitch", tonic); - SCM l = gh_cons (t->self_scm (), SCM_EOL); - - SCM modifiers = gh_cdr (chord); - inversion = gh_car (modifiers); - bass = gh_cdr (modifiers); - - /* This sucks. - Should add (inversion . #t) to the pitch that is an inversion - */ + SCM pitches = tonic_add_sub_to_pitches (tonic, add, sub); + SCM list = SCM_EOL; if (inversion != SCM_EOL) { - Inversion_req* i = new Inversion_req; - i->set_mus_property ("pitch", inversion); - l = gh_cons (i->self_scm (), l); - scm_unprotect_object (i->self_scm ()); + /* If inversion requested, check first if the note is part of chord */ + SCM s = member_pitch (inversion, pitches); + if (s != SCM_BOOL_F) + { + /* Then, delete and add as base note, ie: the inversion */ + pitches = scm_delete (s, pitches); + Note_req* n = new Note_req; + n->set_mus_property ("pitch", gh_car (add_below_tonic (s, pitches))); + n->set_mus_property ("duration", dur); + n->set_mus_property ("inversion", SCM_BOOL_T); + list = gh_cons (n->self_scm (), list); + scm_unprotect_object (n->self_scm ()); + } + else + warning (_f ("invalid inversion pitch: not part of chord: %s", + unsmob_pitch (inversion)->str ())); } - /* - Should add (base . #t) to the pitch that is an added base - */ + /* Bass is easy, just add if requested */ if (bass != SCM_EOL) { - Bass_req* b = new Bass_req; - b->set_mus_property ("pitch", bass); - - l = gh_cons (b->self_scm (), l); - scm_unprotect_object (b->self_scm ()); + Note_req* n = new Note_req; + n->set_mus_property ("pitch", gh_car (add_below_tonic (bass, pitches))); + n->set_mus_property ("duration", dur); + n->set_mus_property ("bass", SCM_BOOL_T); + list = gh_cons (n->self_scm (), list); + scm_unprotect_object (n->self_scm ()); } - - SCM pitches = Chord::to_pitches (chord); + for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i)) { Note_req* n = new Note_req; n->set_mus_property ("pitch", gh_car (i)); n->set_mus_property ("duration", dur); - l = gh_cons (n->self_scm (), l); - + list = gh_cons (n->self_scm (), list); scm_unprotect_object (n->self_scm ()); } - Simultaneous_music*v = new Request_chord (l); + Simultaneous_music*v = new Request_chord (list); return v; } diff --git a/lily/include/chord.hh b/lily/include/chord.hh index 7f63dca1aa..0647233da3 100644 --- a/lily/include/chord.hh +++ b/lily/include/chord.hh @@ -12,33 +12,27 @@ #include "pitch.hh" /* + This is not an Item, just a collection of Chord manipulation helper + functions + ``chord'' is encoded: (PITCHES . (INVERSION . BASS)) - Chord:: namespace... - */ + Chord:: namespace... */ class Chord { public: - static SCM pitches_and_requests_to_chord (SCM pitches, - SCM tonic_req, - SCM inversion_req, - SCM bass_req, - bool find_inversion_b); static SCM base_pitches (SCM tonic); static SCM transpose_pitches (SCM tonic, SCM pitches); static SCM lower_step (SCM tonic, SCM pitches, SCM step); static SCM member_notename (SCM p, SCM pitches); static SCM member_pitch (SCM p, SCM pitches); - static int step_i (Pitch tonic, Pitch p); static SCM step_scm (SCM tonic, SCM p); static SCM missing_thirds (SCM pitches); static SCM to_pitches (SCM chord); - static SCM guess_tonic (SCM pitches); static SCM add_above_tonic (SCM pitch, SCM pitches); static SCM add_below_tonic (SCM pitch, SCM pitches); - static SCM tonic_add_sub_inversion_bass_to_scm (SCM tonic, SCM add, SCM sub, - SCM inversion, SCM bass); + static SCM tonic_add_sub_to_pitches (SCM tonic, SCM add, SCM sub); static Simultaneous_music *get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur); }; diff --git a/lily/include/pitch.hh b/lily/include/pitch.hh index 0ad15815ee..f5cfa19ed0 100644 --- a/lily/include/pitch.hh +++ b/lily/include/pitch.hh @@ -24,8 +24,8 @@ public: // fixme /* TODO: use SCM -- (make private?) */ - - /// 0 is c, 6 is b + + /// 0 is c, 6 is b int notename_i_; /// 0 natural, 1 sharp, etc diff --git a/lily/include/score-element.hh b/lily/include/score-element.hh index 424a182932..84da2f94e8 100644 --- a/lily/include/score-element.hh +++ b/lily/include/score-element.hh @@ -34,7 +34,10 @@ typedef void (Score_element::*Score_element_method_pointer) (void); class Score_element { public: SCM immutable_property_alist_; + + // rename me to ``property_alist_'' SCM mutable_property_alist_; + Score_element *original_l_; /** diff --git a/scm/chord-name.scm b/scm/chord-name.scm new file mode 100644 index 0000000000..d3ad48943c --- /dev/null +++ b/scm/chord-name.scm @@ -0,0 +1,525 @@ +;;; +;;; chord-name.scm -- Compile chord name +;;; +;;; source file of the GNU LilyPond music typesetter +;;; +;;; (c) 2000 Jan Nieuwenhuizen +;;; + + +(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) + ) + +;; +;; (octave notename accidental) +;; + +;; +;; text: scm markup text -- see font.scm and input/test/markup.ly +;; + +;; 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 lilypond +;; * fix append/cons stuff in inner-name-banter +;; * doc strings. + +;;;;;;;;; +(define chord::names-alist-banter '()) +(set! chord::names-alist-banter + (append + '( + ; C iso C.no3.no5 + (((0 . 0)) . #f) + ; C iso C.no5 + (((0 . 0) (2 . 0)) . #f) + ; Cm iso Cm.no5 + (((0 . 0) (2 . -1)) . ("m")) + ; C2 iso C2.no3 + (((0 . 0) (1 . 0) (4 . 0)) . (super "2")) + ; C4 iso C4.no3 + (((0 . 0) (3 . 0) (4 . 0)) . (super "4")) + ; Cdim iso Cm5- + (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) + ; Co iso Cm5-7- + ; urg + (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super "o")) + ; Cdim9 + (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9"))) + (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11"))) + ) + chord::names-alist-banter)) + + +;; NOTE: Duplicates of chord names defined elsewhere occur in this list +;; in order to prevent spurious superscripting of various chord names, +;; such as maj7, maj9, etc. +;; +;; See input/test/american-chords.ly +;; +;; James Hammons, +;; + +;; DONT use non-ascii characters, even if ``it works'' in Windows + +(define chord::names-alist-american '()) + +(set! chord::names-alist-american + (append + '( + (((0 . 0)) . #f) + (((0 . 0) (2 . 0)) . #f) + ;; Root-fifth chord + (((0 . 0) (4 . 0)) . ("5")) + ;; Common triads + (((0 . 0) (2 . -1)) . ("m")) + (((0 . 0) (3 . 0) (4 . 0)) . ("sus")) + (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) +;Alternate: (((0 . 0) (2 . -1) (4 . -1)) . ((super "o"))) + (((0 . 0) (2 . 0) (4 . 1)) . ("aug")) +;Alternate: (((0 . 0) (2 . 0) (4 . 1)) . ("+")) + (((0 . 0) (1 . 0) (4 . 0)) . ("2")) + ;; Common seventh chords + (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (rows (super "o") "7")) + (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7")) + (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7")) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7")) + (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)")) + ;jazz: the delta, see jazz-chords.ly + ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super ((font-family . math) "N")) + ;; slashed o + (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") ((raise . 0.5) ((kern . -0.5) ((font-relative-size . -3) "/"))) "7")) ; slashed o + (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7")) + (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5")) + (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5")) + (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4")) + ;; Common ninth chords + (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7' + (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6")) + (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6")) + (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9")) + (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9")) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9")) + (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9")) + + ) + chord::names-alist-american)) + +;; Jazz chords, by Atte Andr'e Jensen +;; NBs: This uses the american list as a base. +;; Some defs take up more than one line, +;; be carefull when messing with ;'s!! + + +;; FIXME +;; +;; This is getting out-of hand? Only exceptional chord names that +;; cannot be generated should be here. +;; Maybe we should have inner-jazz-name and inner-american-name functions; +;; +;; +;; +;; DONT use non-ascii characters, even if ``it works'' in Windows + +(define chord::names-alist-jazz '()) +(set! chord::names-alist-jazz + (append + '( + ;; major chords + ; major sixth chord = 6 + (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6"))) + ; major seventh chord = triangle + (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . (((raise . 0.5)((font-family . "math") "M")))) + ; major chord add nine = add9 + (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9"))) + ; major sixth chord with nine = 6/9 + (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9"))) + + ;; minor chords + ; minor sixth chord = m6 + (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6"))) + ; minor major seventh chord = m triangle + (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . "math") "M")))) + ; minor seventh chord = m7 + (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7"))) + ; minor sixth nine chord = m6/9 + (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9"))) + ; minor with added nine chord = madd9 + (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9"))) + ; minor ninth chord = m9 + (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9"))) + + ;; dominant chords + ; dominant seventh = 7 + (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7"))) + ; augmented dominant = +7 + ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised + (((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised + ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(") + ; ((raise . 0.3)(music (named ("accidentals-1")))) + ; ((raise . 0.5) "5)"))); 7(#5) + ; dominant flat 5 = 7(b5) + (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.5) "5)"))) + ; dominant 9 = 7(9) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)"))) + ; dominant flat 9 = 7(b9) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . ( + ((raise . 0.8)"7(") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.8)"9)"))) + ; dominant sharp 9 = 7(#9) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . ( + ((raise . 0.8)"7(") + ((raise . 0.3)(music (named ("accidentals-1")))) + ((raise . 0.8)"9)"))) + ; dominant 13 = 7(13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)"))) + ; dominant flat 13 = 7(b13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . ( + ((raise . 0.8)"7(") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.8)"13)"))) + ; dominant 9, 13 = 7(9,13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9, 13)"))) + ; dominant flat 9, 13 = 7(b9,13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . ( + ((raise . 0.8)"7(") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.8)"9, 13)"))) + ; dominant sharp 9, 13 = 7(#9,13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . ( + ((raise . 0.8)"7(") + ((raise . 0.3)(music (named ("accidentals-1")))) + ((raise . 0.8)"9, 13)"))) + ; dominant 9, flat 13 = 7(9,b13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . ( + ((raise . 0.8)"7(9, ") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.8)"13)"))) + ; dominant flat 9, flat 13 = 7(b9,b13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . ( + ((raise . 0.8)"7(") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.8)"9, ") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.8)"13)"))) + ; dominant sharp 9, flat 13 = 7(#9,b13) + (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . ( + ((raise . 0.8)"7(") + ((raise . 0.3)(music (named ("accidentals-1")))) + ((raise . 0.8)"9, ") + ((raise . 0.3)(music (named ("accidentals--1")))) + ((raise . 0.8)"13)"))) + + ;; diminished chord(s) + ; diminished seventh chord = o + + + ;; DONT use non-ascii characters, even if ``it works'' in Windows + + ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (((raise . 0.8)"o"))); works, but "o" is a little big + (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o"))) + + ;; half diminshed chords + ; half diminished seventh chord = slashed o + (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8)"/o"))) + ; half diminished seventh chord with major 9 = slashed o cancelation 9 + (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . ( + ((raise . 0.8)"/o(") + ((raise . 0.3)(music (named ("accidentals-0")))) + ((raise . 0.8)"9)"))); + +;; Missing jazz chord definitions go here (note new syntax: see american for hints) + + ) + 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 + (append '(music) + (list + (append '(named) + (list + (append '((font-relative-size . -2)) + (list (append '((raise . 0.6)) + (list + (string-append "accidentals-" + (number->string (caddr pitch))))))))))))))) + +(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 + '(rows) + (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))) + '((super "/")) + '()) + (let loop ((from additions) (to '())) + (if (pair? from) + (let ((p (car from))) + (loop (cdr from) + (append to + (cons + (list 'super (step->text-banter p)) + (if (or (pair? (cdr from)) + (pair? subtractions)) + '((super "/")) + '()))))) + to)) + (let loop ((from subtractions) (to '())) + (if (pair? from) + (let ((p (car from))) + (loop (cdr from) + (append to + (cons '(super "no") + (cons + (list 'super (step->text-banter p)) + (if (pair? (cdr from)) + '((super "/")) + '())))))) ; nesting? + 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))) + +;; Jazz style--basically similar to american with minor changes +(define (chord::name-jazz 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 (new-to-old-pitch p) + (if (pitch? p) + (list (pitch-octave p) (pitch-notename p) (pitch-alteration p)) + #f + )) + + + +;; 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. +;; +;; CHORD: (pitches (base . inversion)) +(define (default-chord-name-function style chord) + (let* ((pitches (map new-to-old-pitch (car chord))) + (modifiers (cdr chord)) + (base-and-inversion (if (pair? modifiers) + (cons (new-to-old-pitch (car modifiers)) + (new-to-old-pitch (cdr modifiers))) + '(() . ()))) + (diff (pitch::diff '(0 0 0) (car pitches))) + (name-func + (ly-eval (string->symbol (string-append "chord::name-" style)))) + (names-alist + (ly-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)))))) + + diff --git a/scm/chord-names.scm b/scm/chord-names.scm index 25ddef79a9..e69de29bb2 100644 --- a/scm/chord-names.scm +++ b/scm/chord-names.scm @@ -1,521 +0,0 @@ -;;; chord.scm -- to be included in/to replace chord-name.scm -;;; 2000 janneke@gnu.org -;;; - -(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) - ) - -;; -;; (octave notename accidental) -;; - -;; -;; text: scm markup text -- see font.scm and input/test/markup.ly -;; - -;; 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 lilypond -;; * fix append/cons stuff in inner-name-banter -;; * doc strings. - - -;;;;;;;;; -(define chord::names-alist-banter '()) -(set! chord::names-alist-banter - (append - '( - ; C iso C.no3.no5 - (((0 . 0)) . #f) - ; C iso C.no5 - (((0 . 0) (2 . 0)) . #f) - ; Cm iso Cm.no5 - (((0 . 0) (2 . -1)) . ("m")) - ; C2 iso C2.no3 - (((0 . 0) (1 . 0) (4 . 0)) . (super "2")) - ; C4 iso C4.no3 - (((0 . 0) (3 . 0) (4 . 0)) . (super "4")) - ; Cdim iso Cm5- - (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) - ; Co iso Cm5-7- - ; urg - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super "o")) - ; Cdim9 - (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9"))) - (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11"))) - ) - chord::names-alist-banter)) - - -;; NOTE: Duplicates of chord names defined elsewhere occur in this list -;; in order to prevent spurious superscripting of various chord names, -;; such as maj7, maj9, etc. -;; -;; See input/test/american-chords.ly -;; -;; James Hammons, -;; - -;; DONT use non-ascii characters, even if ``it works'' in Windows - -(define chord::names-alist-american '()) - -(set! chord::names-alist-american - (append - '( - (((0 . 0)) . #f) - (((0 . 0) (2 . 0)) . #f) - ;; Root-fifth chord - (((0 . 0) (4 . 0)) . ("5")) - ;; Common triads - (((0 . 0) (2 . -1)) . ("m")) - (((0 . 0) (3 . 0) (4 . 0)) . ("sus")) - (((0 . 0) (2 . -1) (4 . -1)) . ("dim")) -;Alternate: (((0 . 0) (2 . -1) (4 . -1)) . ((super "o"))) - (((0 . 0) (2 . 0) (4 . 1)) . ("aug")) -;Alternate: (((0 . 0) (2 . 0) (4 . 1)) . ("+")) - (((0 . 0) (1 . 0) (4 . 0)) . ("2")) - ;; Common seventh chords - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (rows (super "o") "7")) - (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7")) - (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7")) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7")) - (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)")) - ;jazz: the delta, see jazz-chords.ly - ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super ((font-family . math) "N")) - ;; slashed o - (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") ((raise . 0.5) ((kern . -0.5) ((font-relative-size . -3) "/"))) "7")) ; slashed o - (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7")) - (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5")) - (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5")) - (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4")) - ;; Common ninth chords - (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7' - (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6")) - (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6")) - (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9")) - (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9")) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9")) - (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9")) - - ) - chord::names-alist-american)) - -;; Jazz chords, by Atte Andr'e Jensen -;; NBs: This uses the american list as a base. -;; Some defs take up more than one line, -;; be carefull when messing with ;'s!! - - -;; FIXME -;; -;; This is getting out-of hand? Only exceptional chord names that -;; cannot be generated should be here. -;; Maybe we should have inner-jazz-name and inner-american-name functions; -;; -;; -;; -;; DONT use non-ascii characters, even if ``it works'' in Windows - -(define chord::names-alist-jazz '()) -(set! chord::names-alist-jazz - (append - '( - ;; major chords - ; major sixth chord = 6 - (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6"))) - ; major seventh chord = triangle - (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . (((raise . 0.5)((font-family . "math") "M")))) - ; major chord add nine = add9 - (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9"))) - ; major sixth chord with nine = 6/9 - (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9"))) - - ;; minor chords - ; minor sixth chord = m6 - (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6"))) - ; minor major seventh chord = m triangle - (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . "math") "M")))) - ; minor seventh chord = m7 - (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7"))) - ; minor sixth nine chord = m6/9 - (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9"))) - ; minor with added nine chord = madd9 - (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9"))) - ; minor ninth chord = m9 - (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9"))) - - ;; dominant chords - ; dominant seventh = 7 - (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7"))) - ; augmented dominant = +7 - ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised - (((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised - ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(") - ; ((raise . 0.3)(music (named ("accidentals-1")))) - ; ((raise . 0.5) "5)"))); 7(#5) - ; dominant flat 5 = 7(b5) - (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.5) "5)"))) - ; dominant 9 = 7(9) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)"))) - ; dominant flat 9 = 7(b9) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"9)"))) - ; dominant sharp 9 = 7(#9) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals-1")))) - ((raise . 0.8)"9)"))) - ; dominant 13 = 7(13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)"))) - ; dominant flat 13 = 7(b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - ; dominant 9, 13 = 7(9,13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9, 13)"))) - ; dominant flat 9, 13 = 7(b9,13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"9, 13)"))) - ; dominant sharp 9, 13 = 7(#9,13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals-1")))) - ((raise . 0.8)"9, 13)"))) - ; dominant 9, flat 13 = 7(9,b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . ( - ((raise . 0.8)"7(9, ") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - ; dominant flat 9, flat 13 = 7(b9,b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"9, ") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - ; dominant sharp 9, flat 13 = 7(#9,b13) - (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . ( - ((raise . 0.8)"7(") - ((raise . 0.3)(music (named ("accidentals-1")))) - ((raise . 0.8)"9, ") - ((raise . 0.3)(music (named ("accidentals--1")))) - ((raise . 0.8)"13)"))) - - ;; diminished chord(s) - ; diminished seventh chord = o - - - ;; DONT use non-ascii characters, even if ``it works'' in Windows - - ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (((raise . 0.8)"o"))); works, but "o" is a little big - (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o"))) - - ;; half diminshed chords - ; half diminished seventh chord = slashed o - (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8)"/o"))) - ; half diminished seventh chord with major 9 = slashed o cancelation 9 - (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . ( - ((raise . 0.8)"/o(") - ((raise . 0.3)(music (named ("accidentals-0")))) - ((raise . 0.8)"9)"))); - -;; Missing jazz chord definitions go here (note new syntax: see american for hints) - - ) - 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 - (append '(music) - (list - (append '(named) - (list - (append '((font-relative-size . -2)) - (list (append '((raise . 0.6)) - (list - (string-append "accidentals-" - (number->string (caddr pitch))))))))))))))) - -(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 - '(rows) - (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))) - '((super "/")) - '()) - (let loop ((from additions) (to '())) - (if (pair? from) - (let ((p (car from))) - (loop (cdr from) - (append to - (cons - (list 'super (step->text-banter p)) - (if (or (pair? (cdr from)) - (pair? subtractions)) - '((super "/")) - '()))))) - to)) - (let loop ((from subtractions) (to '())) - (if (pair? from) - (let ((p (car from))) - (loop (cdr from) - (append to - (cons '(super "no") - (cons - (list 'super (step->text-banter p)) - (if (pair? (cdr from)) - '((super "/")) - '())))))) ; nesting? - 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))) - -;; Jazz style--basically similar to american with minor changes -(define (chord::name-jazz 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 (new-to-old-pitch p) - (if (pitch? p) - (list (pitch-octave p) (pitch-notename p) (pitch-alteration p)) - #f - )) - - - -;; 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 (default-chord-name-function style pitches base-and-inversion) - ;(display "pitches:") (display pitches) (newline) - ;(display "style:") (display style) (newline) - ;(display "b&i:") (display base-and-inversion) (newline) - (set! pitches (map new-to-old-pitch pitches)) - (set! base-and-inversion (cons (new-to-old-pitch (car base-and-inversion)) - (new-to-old-pitch (cdr base-and-inversion)))) - - (let ((diff (pitch::diff '(0 0 0) (car pitches))) - (name-func - (ly-eval (string->symbol (string-append "chord::name-" style)))) - (names-alist - (ly-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)))))) - - diff --git a/scm/lily.scm b/scm/lily.scm index 0e664d2ebd..d701f4dc68 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -764,7 +764,7 @@ (eval-string (ly-gulp-file "auto-beam.scm")) (eval-string (ly-gulp-file "generic-property.scm")) (eval-string (ly-gulp-file "basic-properties.scm")) - (eval-string (ly-gulp-file "chord-names.scm")) + (eval-string (ly-gulp-file "chord-name.scm")) (eval-string (ly-gulp-file "element-descriptions.scm")) )