From 099d07eaa13358b727745d8bf834f3ac3969b1c3 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 22 Feb 2003 02:28:00 +0000 Subject: [PATCH] junk contents. --- ChangeLog | 4 + Documentation/user/refman.itely | 2 +- input/regression/chord-name-entry.ly | 34 +++ lily/chord.cc | 375 +------------------------- lily/include/chord.hh | 39 --- lily/parser.yy | 3 +- scm/chord-entry.scm | 380 +++++++++++++++++---------- scm/music-property-description.scm | 2 + 8 files changed, 283 insertions(+), 556 deletions(-) create mode 100644 input/regression/chord-name-entry.ly diff --git a/ChangeLog b/ChangeLog index cb8d5fcb94..266dca26a5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2003-02-22 Han-Wen Nienhuys + + * lily/chord.cc: junk contents. + 2003-02-17 Heikki Junes * Documentation/user/refman.itely: diff --git a/Documentation/user/refman.itely b/Documentation/user/refman.itely index 0c1a844b5a..1e4214c470 100644 --- a/Documentation/user/refman.itely +++ b/Documentation/user/refman.itely @@ -4864,7 +4864,7 @@ letters by a factor 2 in both directions. Relative size is not linked to any real size. There is no style sheet provided for other fonts besides the @TeX{} -family, and the style sheet can not be modified easiyl. +family, and the style sheet can not be modified easily. @cindex font selection @cindex font magnification diff --git a/input/regression/chord-name-entry.ly b/input/regression/chord-name-entry.ly new file mode 100644 index 0000000000..3fa92bf71e --- /dev/null +++ b/input/regression/chord-name-entry.ly @@ -0,0 +1,34 @@ +\header { + +texidoc = "Test file for the new chordname entry code: the suffixes are printed below the pitches." + +} + +\score +{ +\notes { \context Voice \chords { +c1_"1" +c:7_"7" +c:m_":m" +c:m7_":m7" +c:aug_":aug" +c:maj7_":maj7" +c:dim_":dim" +c:dim7_":dim7" +c:sus4_":sus4" +c:sus2_":sus2" +c:3-_":3-" +c:3+_":3+" +c:5+.3-_":5+.3-" +c:7_":7" +c:9_":9" +c:11_":11" +c:13_":13" +c:m13_":m13" +c:7^5_":7\\^{ }5" +c^3_"\\^{ }3" +c/g_"/g" +c/+f_"/+f" +} +} +} diff --git a/lily/chord.cc b/lily/chord.cc index 169b155713..ebadfa906d 100644 --- a/lily/chord.cc +++ b/lily/chord.cc @@ -1,375 +1,2 @@ -/* - chord.cc -- implement Chord - - source file of the GNU LilyPond music typesetter - - (c) 1999--2003 Jan Nieuwenhuizen -*/ - -#include "chord.hh" -#include "event.hh" -#include "warn.hh" - -#include "music-list.hh" -#include "event.hh" - - -SCM -Chord::base_pitches (SCM tonic) -{ - SCM base = SCM_EOL; - - SCM major = Pitch (0, 2, 0).smobbed_copy (); - SCM minor = Pitch (0, 2, -1).smobbed_copy (); - - base = gh_cons (tonic, base); - base = gh_cons (ly_pitch_transpose (ly_car (base), major), base); - base = gh_cons (ly_pitch_transpose (ly_car (base), minor), base); - - return scm_reverse_x (base, SCM_EOL); -} - -SCM -Chord::transpose_pitches (SCM tonic, SCM pitches) -{ - /* map? - hoe doe je lambda in C? - */ - SCM transposed = SCM_EOL; - for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i)) - { - transposed = gh_cons (ly_pitch_transpose (tonic, ly_car (i)), - transposed); - } - return scm_reverse_x (transposed, SCM_EOL); -} - -/* - burp, in SCM duw je gewoon een (if (= (step x) 7) (...)) door pitches - - Lower step STEP. - If step == 0, lower all. - */ -SCM -Chord::lower_step (SCM tonic, SCM pitches, SCM step) -{ - SCM lowered = SCM_EOL; - for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i)) - { - SCM p = ly_car (i); - if (gh_equal_p (step_scm (tonic, ly_car (i)), step) - || gh_scm2int (step) == 0) - { - p = ly_pitch_transpose (p, Pitch (0, 0, -1).smobbed_copy ()); - } - lowered = gh_cons (p, lowered); - } - return scm_reverse_x (lowered, SCM_EOL); -} - -/* Return member that has same notename, disregarding octave or alterations */ -SCM -Chord::member_notename (SCM p, SCM pitches) -{ - /* If there's an exact match, make sure to return that */ - SCM member = gh_member (p, pitches); - if (member == SCM_BOOL_F) - { - for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i)) - { - /* - Urg, eindelijk gevonden: () != #f, kan maar niet aan wennen. - Anders kon iets korter... - */ - if (unsmob_pitch (p)->get_notename () - == unsmob_pitch (ly_car (i))->get_notename ()) - { - member = ly_car (i); - break; - } - } - } - else - member = ly_car (member); - return member; -} - -/* Return member that has same notename and alteration, disregarding octave */ -SCM -Chord::member_pitch (SCM p, SCM pitches) -{ - /* If there's an exact match, make sure to return that */ - SCM member = gh_member (p, pitches); - if (member == SCM_BOOL_F) - { - for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i)) - { - if (unsmob_pitch (p)->get_notename () - == unsmob_pitch (ly_car (i))->get_notename () - && unsmob_pitch (p)->get_alteration() - == unsmob_pitch (ly_car (i))->get_alteration()) - { - member = ly_car (i); - break; - } - } - } - else - member = ly_car (member); - return member; -} - -SCM -Chord::step_scm (SCM tonic, SCM p) -{ - /* De Pitch intervaas is nog beetje sleutelgat? */ - int i = unsmob_pitch (p)->get_notename () - - unsmob_pitch (tonic)->get_notename () - + (unsmob_pitch (p)->get_octave () - - unsmob_pitch (tonic)->get_octave ()) * 7; - while (i < 0) - i += 7; - i++; - return scm_int2num (i); -} - -/* - Assuming that PITCHES is a chord, with tonic (CAR PITCHES), find - missing thirds, only considering notenames. Eg, for - - PITCHES = c gis d' - - return - - MISSING = e b' - -*/ -SCM -Chord::missing_thirds (SCM pitches) -{ - SCM thirds = SCM_EOL; - - /* is the third c-e, d-f, etc. small or large? */ - int minormajor_a[] = {0, -1, -1, 0, 0, -1, -1}; - for (int i=0; i < 7; i++) - thirds = gh_cons (Pitch (0, 2, minormajor_a[i]).smobbed_copy (), - thirds); - thirds = scm_vector (scm_reverse_x (thirds, SCM_EOL)); - - SCM tonic = ly_car (pitches); - SCM last = tonic; - SCM missing = SCM_EOL; - - for (SCM i = pitches; gh_pair_p (i);) - { - SCM p = ly_car (i); - int step = gh_scm2int (step_scm (tonic, p)); - - if (unsmob_pitch (last)->get_notename () == unsmob_pitch (p)->get_notename ()) - { - int third = (unsmob_pitch (last)->get_notename () - - unsmob_pitch (tonic)-> get_notename () + 7) % 7; - last = ly_pitch_transpose (last, scm_vector_ref (thirds, scm_int2num (third))); - } - - if (step > gh_scm2int (step_scm (tonic, last))) - { - while (step > gh_scm2int (step_scm (tonic, last))) - { - missing = gh_cons (last, missing); - int third = (unsmob_pitch (last)->get_notename () - - unsmob_pitch (tonic)->get_notename () + 7) % 7; - last = ly_pitch_transpose (last, scm_vector_ref (thirds, - scm_int2num (third))); - } - } - else - { - i = ly_cdr (i); - } - } - - return lower_step (tonic, missing, scm_int2num (7)); -} - -/* Return PITCHES with PITCH added not as lowest note */ -SCM -Chord::add_above_tonic (SCM pitch, SCM pitches) -{ - /* Should we maybe first make sure that PITCH is below tonic? */ - if (pitches != SCM_EOL) - while (Pitch::less_p (pitch, ly_car (pitches)) == SCM_BOOL_T) - pitch = ly_pitch_transpose (pitch, Pitch (1, 0, 0).smobbed_copy ()); - - pitches = gh_cons (pitch, pitches); - return scm_sort_list (pitches, Pitch::less_p_proc); -} - -/* Return PITCHES with PITCH added as lowest note */ -SCM -Chord::add_below_tonic (SCM pitch, SCM pitches) -{ - if (pitches != SCM_EOL) - while (Pitch::less_p (ly_car (pitches), pitch) == SCM_BOOL_T) - pitch = ly_pitch_transpose (pitch, Pitch (-1, 0, 0).smobbed_copy ()); - return gh_cons (pitch, pitches); -} - - - -/* - Parser stuff - - Construct from parser output: - - 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_to_pitches (SCM tonic, SCM add, SCM sub) -{ - /* urg: catch dim modifier: 3rd, 5th, 7th, .. should be lowered */ - bool dim_b = false; - for (SCM i = add; gh_pair_p (i); i = ly_cdr (i)) - { - Pitch* p = unsmob_pitch (ly_car (i)); - /* Ugr - This chord modifier stuff should really be fixed - Cmaj7 yields C 7/7- - */ - if (p->get_octave () == -100) - { - dim_b = true; - Pitch t (0, p->get_notename(), p->get_alteration()); - gh_set_car_x (i, t.smobbed_copy()); - dim_b = true; - } - } - - add = transpose_pitches (tonic, add); - add = lower_step (tonic, add, scm_int2num (7)); - add = scm_sort_list (add, Pitch::less_p_proc); - add = ly_unique (add); - - sub = transpose_pitches (tonic, sub); - sub = lower_step (tonic, sub, scm_int2num (7)); - sub = scm_sort_list (sub, Pitch::less_p_proc); - - /* default chord includes upto 5: <1, 3, 5> */ - add = gh_cons (tonic, add); - SCM tmp = add; - - SCM fifth = ly_last (base_pitches (tonic)); - int highest_step = gh_scm2int (step_scm (tonic, ly_last (tmp))); - if (highest_step < 5) - tmp = ly_snoc (fifth, tmp); - else if (dim_b) - { - add = lower_step (tonic, add, scm_int2num (5)); - add = lower_step (tonic, add, scm_int2num (7)); - } - - /* find missing thirds */ - SCM missing = missing_thirds (tmp); - if (highest_step < 5) - missing = ly_snoc (fifth, missing); - - /* if dim modifier is given: lower all missing */ - if (dim_b) - missing = lower_step (tonic, missing, scm_int2num (0)); - - /* if additions include any 3, don't add third */ - SCM third = ly_cadr (base_pitches (tonic)); - if (member_notename (third, add) != SCM_BOOL_F) - missing = scm_delete (third, missing); - - /* if additions include any 4, assume sus4 and don't add third implicitely - C-sus (4) = c f g (1 4 5) */ - SCM sus = ly_pitch_transpose (tonic, Pitch (0, 3, 0).smobbed_copy ()); - if (member_notename (sus, add) != SCM_BOOL_F) - missing = scm_delete (third, missing); - - /* if additions include some 5, don't add fifth */ - if (member_notename (fifth, add) != SCM_BOOL_F) - missing = scm_delete (fifth, missing); - - /* complete the list of thirds to be added */ - add = gh_append2 (missing, add); - add = scm_sort_list (add, Pitch::less_p_proc); - - SCM pitches = SCM_EOL; - /* Add all that aren't subtracted */ - for (SCM i = add; gh_pair_p (i); i = ly_cdr (i)) - { - SCM p = ly_car (i); - SCM s = member_notename (p, sub); - if (s != SCM_BOOL_F) - sub = scm_delete (s, sub); - else - pitches = gh_cons (p, pitches); - } - pitches = scm_sort_list (pitches, Pitch::less_p_proc); - - for (SCM i = sub; gh_pair_p (i); i = ly_cdr (i)) - warning (_f ("invalid subtraction: not part of chord: %s", - unsmob_pitch (ly_car (i))->to_string ())); - - return pitches; -} - - -/* --Het lijkt me dat dit in het paarse gedeelte moet. */ -Music * -Chord::get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur) -{ - SCM pitches = tonic_add_sub_to_pitches (tonic, add, sub); - SCM list = SCM_EOL; - 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 */ - pitches = scm_delete (s, pitches); - Music * n = make_music_by_name (ly_symbol2scm ("NoteEvent")); - n->set_mus_property ("pitch", ly_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_gc_unprotect_object (n->self_scm ()); - } - else - warning (_f ("invalid inversion pitch: not part of chord: %s", - unsmob_pitch (inversion)->to_string ())); - } - - /* Bass is easy, just add if requested */ - if (bass != SCM_EOL) - { - Music * n = make_music_by_name (ly_symbol2scm ("NoteEvent")); - n->set_mus_property ("pitch", ly_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_gc_unprotect_object (n->self_scm ()); - } - - for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i)) - { - Music * n = make_music_by_name(ly_symbol2scm ("NoteEvent")); - n->set_mus_property ("pitch", ly_car (i)); - n->set_mus_property ("duration", dur); - list = gh_cons (n->self_scm (), list); - scm_gc_unprotect_object (n->self_scm ()); - } - - Music * v = make_music_by_name(ly_symbol2scm ("EventChord")); - v->set_mus_property ("elements", list); - - return v; -} - +// duh diff --git a/lily/include/chord.hh b/lily/include/chord.hh index 3386d69d2c..e69de29bb2 100644 --- a/lily/include/chord.hh +++ b/lily/include/chord.hh @@ -1,39 +0,0 @@ -/* - chord.hh -- declare Chord - - source file of the GNU LilyPond music typesetter - - (c) 1999--2002 Jan Nieuwenhuizen -*/ - -#ifndef CHORD_HH -#define CHORD_HH - -#include "pitch.hh" - -/* - This is not an Item, just a collection of Chord manipulation helper - functions - - ``chord'' is encoded: - (PITCHES . (INVERSION . BASS)) - - Chord:: namespace... */ -class Chord -{ -public: - 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 SCM step_scm (SCM tonic, SCM p); - static SCM missing_thirds (SCM pitches); - static SCM to_pitches (SCM chord); - static SCM add_above_tonic (SCM pitch, SCM pitches); - static SCM add_below_tonic (SCM pitch, SCM pitches); - static SCM tonic_add_sub_to_pitches (SCM tonic, SCM add, SCM sub); - static Music *get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur); -}; - -#endif /* CHORD_HH */ diff --git a/lily/parser.yy b/lily/parser.yy index 001370dab4..ec86f94ed2 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -67,7 +67,6 @@ TODO: #include "lilypond-input-version.hh" #include "scm-hash.hh" #include "auto-change-iterator.hh" -#include "chord.hh" #include "ly-modules.hh" #include "music-sequence.hh" #include "input-smob.hh" @@ -2018,7 +2017,7 @@ chord_separator: $$ = ly_symbol2scm ("chord-caret"); } | CHORD_SLASH steno_tonic_pitch { - $$ = scm_list_n (ly_symbol2scm ("chord-slash"), $2, SCM_UNDEFINED); + $$ = scm_list_n (ly_symbol2scm ("chord-slash"), $2, SCM_UNDEFINED); } | CHORD_BASS steno_tonic_pitch { $$ = scm_list_n (ly_symbol2scm ("chord-bass"), $2, SCM_UNDEFINED); diff --git a/scm/chord-entry.scm b/scm/chord-entry.scm index d68c31db19..e9f5f2bbae 100644 --- a/scm/chord-entry.scm +++ b/scm/chord-entry.scm @@ -1,7 +1,196 @@ +;;; +;;; Generate chord names for the parser. +;;; +;;; + +(define-public (construct-chord root duration modifications) + + " Build a chord on root using modifiers in MODIFICATIONS. NoteEvent +have duration DURATION.. + +Notes: natural 11 is left from chord if not explicitly specified. + +Entry point for the parser. + +" + (let* + ( + (flat-mods (flatten-list modifications)) + (base-chord (stack-thirds (ly:make-pitch 0 4 0) the-canonical-chord)) + (complete-chord '()) + (bass #f) + (inversion #f) + (lead-mod #f) + (explicit-11 #f) + (start-additions #t) + ) + + (define (interpret-inversion chord mods) + "Read /FOO part. Side effect: INVERSION is set." + + (if (and (> (length mods) 1) (eq? (car mods) 'chord-slash)) + (begin + (set! inversion (cadr mods)) + (set! mods (cddr mods)))) + + (interpret-bass chord mods)) + + (define (interpret-bass chord mods) + "Read /+FOO part. Side effect: BASS is set." + + (if (and (> (length mods) 1) (eq? (car mods) 'chord-bass)) + (begin + (set! bass (cadr mods)) + (set! mods (cddr mods)))) + + (if (pair? mods) + (scm-error 'chord-format "construct-chord" "Spurious garbage following chord: ~A" mods #f) + ) + + chord + ) + + (define (interpret-removals chord mods) + (define (inner-interpret chord mods) + (if (and (pair? mods) (ly:pitch? (car mods))) + (inner-interpret + (remove-step (+ 1 (ly:pitch-steps (car mods))) chord) + (cdr mods)) + (interpret-inversion chord mods)) + ) + + (if (and (pair? mods) (eq? (car mods) 'chord-caret)) + (inner-interpret chord (cdr mods)) + (interpret-inversion chord mods)) + + ) + + (define (interpret-additions chord mods) + "Interpret additions. TODO: should restrict modifier use?" + (cond + ((null? mods) chord) + ((ly:pitch? (car mods)) + (if (= (ly:pitch-steps (car mods)) 11) + (set! explicit-11 #t)) + (interpret-additions + (cons (car mods) (remove-step (pitch-step (car mods)) chord)) + (cdr mods))) + ((procedure? (car mods)) + (interpret-additions + ((car mods) chord) + (cdr mods))) + (else (interpret-removals chord mods)) + )) + + (define (process-inversion complete-chord) + "Take out inversion from COMPLETE-CHORD, and put it at the bottom. +Return (INVERSION . REST-OF-CHORD). + +Side effect: put original pitch in INVERSION. +" + (let* + ( + (root (car complete-chord)) + (inv? (lambda (y) + (= (ly:pitch-notename y) + (ly:pitch-notename inversion)))) + (rest-of-chord (filter-out-list inv? complete-chord)) + (inversion-candidates (filter-list inv? complete-chord)) + (down-inversion (ly:make-pitch + (+ + (ly:pitch-octave root) + (if (>= (ly:pitch-notename root) + (ly:pitch-notename inversion)) + 0 -1)) + (ly:pitch-notename inversion) + (ly:pitch-alteration inversion))) + ) + + (if (pair? inversion-candidates) + (set! inversion (car inversion-candidates))) + + (cons down-inversion rest-of-chord) + )) + + ;; root is always one octave too low. + + ; something weird happens when this is removed, + ; every other chord is octavated. --hwn... hmmm. + (set! root (ly:pitch-transpose root (ly:make-pitch 1 0 0))) + + (if #f + (begin + (write-me "\n*******\n" flat-mods) + (write-me "root: " root) + (write-me "base: " base-chord) + (write-me "bass: " bass))) + + ;; skip the leading : , we need some of the stuff following it. + (if (pair? flat-mods) + (if (eq? (car flat-mods) 'chord-colon) + (set! flat-mods (cdr flat-mods)) + (set! start-additions #f) + )) + + ;; remember modifier + (if (and (pair? flat-mods) (procedure? (car flat-mods))) + (begin + (set! lead-mod (car flat-mods)) + (set! flat-mods (cdr flat-mods)) + )) + + ;; extract first number if present, and build pitch list. + (if (and (pair? flat-mods) + (ly:pitch? (car flat-mods)) + (not (eq? lead-mod sus-modifier)) + ) + + (begin + (if (= (pitch-step (car flat-mods)) 11) + (set! explicit-11 #t)) + (set! base-chord + (map (lambda (y) (ly:pitch-transpose y root)) + (stack-thirds (car flat-mods) the-canonical-chord))) + (set! flat-mods (cdr flat-mods)) + )) + + ;; apply modifier + (if (procedure? lead-mod) + (set! base-chord (lead-mod base-chord))) + + + (set! complete-chord + (if start-additions + (interpret-additions base-chord flat-mods) + (interpret-removals base-chord flat-mods) + )) + + + (set! complete-chord (map (lambda (x) (ly:pitch-transpose x root)) + (sort complete-chord ly:pitch= n 8) + (ly:make-pitch 1 (- n 8) (nca n)) + (ly:make-pitch 0 (- n 1) (nca n)))) + '(1 3 5 7 9 11 13))) -Side-effect: set BASS and INVERSION in containing body -" - ;; the recursion makes this into a loop. Perhaps its better to - ;; to do the different types of modifiers in order, so that - ;; addition _always_ precedes removal. - (if (null? mods) - chord - (let* ( - (tag (car mods)) - (tail (cdr mods)) - ) - (cond - ((procedure? tag) - (interpret-chord root - (tag root chord) - tail)) - ((equal? tag 'chord-colon) - (interpret-chord root - (add-pitches root chord tail) - (gobble-pitches tail))) - ((equal? tag 'chord-caret) - (interpret-chord root - (rm-pitches root chord tail) - (gobble-pitches tail))) - - ((equal? tag 'chord-slash) - (set! inversion (car tail)) - (interpret-chord root - chord - (gobble-pitches tail))) - ((equal? tag 'chord-bass) - (set! bass (car tail)) - (interpret-chord root - chord - (gobble-pitches tail))) - - ;; ugh. Simply add isolated pitches. This will give - ;; unexpected results.... - ((ly:pitch? tag) - (interpret-chord root - (add-pitches root chord tail) - (gobble-pitches tail))) - (else (scm-error 'chord-entry 'interpret-chord "Unknown chord instructions ~S." (list mods) #f)) - ) - ) - )) - - (write-me "*******\n" flat-mods) - (write-me "pitches: " complete-chord) - (write-me "bass: " bass) +(define (stack-thirds upper-step base) + "Stack thirds listed in BASE until we reach UPPER-STEP. Add +UPPER-STEP separately." + (cond + ((null? base) '()) + ((> (ly:pitch-steps upper-step) (ly:pitch-steps (car base))) + (cons (car base) (stack-thirds upper-step (cdr base)))) + ((= (ly:pitch-steps upper-step) (ly:pitch-steps (car base))) + (list upper-step)) + (else '()) + )) - (set! complete-chord (interpret-chord root base-chord flat-mods)) - (set! complete-chord (sort complete-chord ly:pitch