-1.3.107.jcn5
+1.3.108.jcn2
============
-* Removed some hair from chord.cc
+* Removed some hair from chord code.
1.3.107.jcn3
============
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.
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);
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<Note_req*> (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
{
if (Note_req* n = dynamic_cast<Note_req*> (m))
{
- pitches_ = gh_cons (n->get_mus_property ("pitch"), pitches_);
- return true;
- }
- if (Tonic_req* t = dynamic_cast<Tonic_req*> (m))
- {
- tonic_req_ = t->get_mus_property ("pitch");
- return true;
- }
- if (Inversion_req* i = dynamic_cast<Inversion_req*> (m))
- {
- inversion_req_ = i->get_mus_property ("pitch");
- return true;
- }
- if (Bass_req* b = dynamic_cast<Bass_req*> (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<Note_req*> (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 &&
}
}
-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 ()
{
}
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));
}
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);
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.
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);
}
/*
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
- <e g c'> 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)
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;
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;
}
#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);
};
/*
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
class Score_element {
public:
SCM immutable_property_alist_;
+
+ // rename me to ``property_alist_''
SCM mutable_property_alist_;
+
Score_element *original_l_;
/**
--- /dev/null
+;;;
+;;; chord-name.scm -- Compile chord name
+;;;
+;;; source file of the GNU LilyPond music typesetter
+;;;
+;;; (c) 2000 Jan Nieuwenhuizen <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, <jlhamm@pacificnet.net>
+;;
+
+;; 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 <atte@post.com>
+;; 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))))))
+
+
-;;; 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, <jlhamm@pacificnet.net>
-;;
-
-;; 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 <atte@post.com>
-;; 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))))))
-
-
(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"))
)
projects / lilypond.git / commitdiff