lily/chord.cc

   1 /*
   2   chord.cc -- implement Chord
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1999--2003 Jan Nieuwenhuizen <janneke@gnu.org>
   7 */
   8
   9 #include "chord.hh"
  10 #include "event.hh"
  11 #include "warn.hh"
  12
  13 #include "music-list.hh"
  14 #include "event.hh"
  15
  16
  17 SCM
  18 Chord::base_pitches (SCM tonic)
  19 {
  20   SCM base = SCM_EOL;
  21
  22   SCM major = Pitch (0, 2, 0).smobbed_copy ();
  23   SCM minor = Pitch (0, 2, -1).smobbed_copy ();
  24
  25   base = gh_cons (tonic, base);
  26   base = gh_cons (ly_pitch_transpose (ly_car (base), major), base);
  27   base = gh_cons (ly_pitch_transpose (ly_car (base), minor), base);
  28
  29   return scm_reverse_x (base, SCM_EOL);
  30 }
  31
  32 SCM
  33 Chord::transpose_pitches (SCM tonic, SCM pitches)
  34 {
  35   /* map?
  36      hoe doe je lambda in C?
  37   */
  38   SCM transposed = SCM_EOL;
  39   for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i))
  40     {
  41       transposed = gh_cons (ly_pitch_transpose (tonic, ly_car (i)),
  42                             transposed);
  43     }
  44   return scm_reverse_x (transposed, SCM_EOL);
  45 }
  46
  47 /*
  48   burp, in SCM duw je gewoon een (if (= (step x) 7) (...)) door pitches
  49
  50   Lower step STEP.
  51   If step == 0, lower all.
  52  */
  53 SCM
  54 Chord::lower_step (SCM tonic, SCM pitches, SCM step)
  55 {
  56   SCM lowered = SCM_EOL;
  57   for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i))
  58     {
  59       SCM p = ly_car (i);
  60       if (gh_equal_p (step_scm (tonic, ly_car (i)), step)
  61           || gh_scm2int (step) == 0)
  62         {
  63           p = ly_pitch_transpose (p, Pitch (0, 0, -1).smobbed_copy ());
  64         }
  65       lowered = gh_cons (p, lowered);
  66     }
  67   return scm_reverse_x (lowered, SCM_EOL);
  68 }
  69
  70 /* Return member that has same notename, disregarding octave or alterations */
  71 SCM
  72 Chord::member_notename (SCM p, SCM pitches)
  73 {
  74   /* If there's an exact match, make sure to return that */
  75   SCM member = gh_member (p, pitches);
  76   if (member == SCM_BOOL_F)
  77     {
  78       for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i))
  79         {
  80           /*
  81             Urg, eindelijk gevonden: () != #f, kan maar niet aan wennen.
  82             Anders kon iets korter...
  83            */
  84           if (unsmob_pitch (p)->get_notename ()
  85               == unsmob_pitch (ly_car (i))->get_notename ())
  86             {
  87               member = ly_car (i);
  88               break;
  89             }
  90         }
  91     }
  92   else
  93     member = ly_car (member);
  94   return member;
  95 }
  96
  97 /* Return member that has same notename and alteration, disregarding octave */
  98 SCM
  99 Chord::member_pitch (SCM p, SCM pitches)
 100 {
 101   /* If there's an exact match, make sure to return that */
 102   SCM member = gh_member (p, pitches);
 103   if (member == SCM_BOOL_F)
 104     {
 105       for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i))
 106         {
 107           if (unsmob_pitch (p)->get_notename ()
 108               == unsmob_pitch (ly_car (i))->get_notename ()
 109               && unsmob_pitch (p)->get_alteration()
 110               == unsmob_pitch (ly_car (i))->get_alteration())
 111             {
 112               member = ly_car (i);
 113               break;
 114             }
 115         }
 116     }
 117   else
 118     member = ly_car (member);
 119   return member;
 120 }
 121
 122 SCM
 123 Chord::step_scm (SCM tonic, SCM p)
 124 {
 125   /* De Pitch intervaas is nog beetje sleutelgat? */
 126   int i = unsmob_pitch (p)->get_notename ()
 127     - unsmob_pitch (tonic)->get_notename ()
 128     + (unsmob_pitch (p)->get_octave ()
 129        - unsmob_pitch (tonic)->get_octave ()) * 7;
 130   while (i < 0)
 131     i += 7;
 132   i++;
 133   return scm_int2num (i);
 134 }
 135
 136 /*
 137   Assuming that PITCHES is a chord, with tonic (CAR PITCHES), find
 138   missing thirds, only considering notenames.  Eg, for
 139
 140     PITCHES = c gis d'
 141
 142   return
 143
 144     MISSING = e b'
 145
 146 */
 147 SCM
 148 Chord::missing_thirds (SCM pitches)
 149 {
 150   SCM thirds = SCM_EOL;
 151
 152   /* is the third c-e, d-f, etc. small or large? */
 153   int minormajor_a[] = {0, -1, -1, 0, 0, -1, -1};
 154   for (int i=0; i < 7; i++)
 155     thirds = gh_cons (Pitch (0, 2, minormajor_a[i]).smobbed_copy (),
 156                       thirds);
 157   thirds = scm_vector (scm_reverse_x (thirds, SCM_EOL));
 158
 159   SCM tonic = ly_car (pitches);
 160   SCM last = tonic;
 161   SCM missing = SCM_EOL;
 162
 163   for (SCM i = pitches; gh_pair_p (i);)
 164     {
 165       SCM p = ly_car (i);
 166       int step = gh_scm2int (step_scm (tonic, p));
 167
 168       if (unsmob_pitch (last)->get_notename () == unsmob_pitch (p)->get_notename ())
 169         {
 170           int third = (unsmob_pitch (last)->get_notename ()
 171                        - unsmob_pitch (tonic)-> get_notename () + 7) % 7;
 172           last = ly_pitch_transpose (last, scm_vector_ref (thirds, scm_int2num (third)));
 173         }
 174
 175       if (step > gh_scm2int (step_scm (tonic, last)))
 176         {
 177           while (step > gh_scm2int (step_scm (tonic, last)))
 178             {
 179               missing = gh_cons (last, missing);
 180               int third = (unsmob_pitch (last)->get_notename ()
 181                            - unsmob_pitch (tonic)->get_notename () + 7) % 7;
 182               last = ly_pitch_transpose (last, scm_vector_ref (thirds,
 183                                                       scm_int2num (third)));
 184             }
 185         }
 186       else
 187         {
 188           i = ly_cdr (i);
 189         }
 190     }
 191
 192   return lower_step (tonic, missing, scm_int2num (7));
 193 }
 194
 195 /* Return PITCHES with PITCH added not as lowest note */
 196 SCM
 197 Chord::add_above_tonic (SCM pitch, SCM pitches)
 198 {
 199   /* Should we maybe first make sure that PITCH is below tonic? */
 200   if (pitches != SCM_EOL)
 201     while (Pitch::less_p (pitch, ly_car (pitches)) == SCM_BOOL_T)
 202       pitch = ly_pitch_transpose (pitch, Pitch (1, 0, 0).smobbed_copy ());
 203
 204   pitches = gh_cons (pitch, pitches);
 205   return scm_sort_list (pitches, Pitch::less_p_proc);
 206 }
 207
 208 /* Return PITCHES with PITCH added as lowest note */
 209 SCM
 210 Chord::add_below_tonic (SCM pitch, SCM pitches)
 211 {
 212   if (pitches != SCM_EOL)
 213     while (Pitch::less_p (ly_car (pitches), pitch) == SCM_BOOL_T)
 214       pitch = ly_pitch_transpose (pitch, Pitch (-1, 0, 0).smobbed_copy ());
 215   return gh_cons (pitch, pitches);
 216 }
 217
 218
 219
 220 /*
 221   Parser stuff
 222
 223   Construct from parser output:
 224
 225   PITCHES is the plain chord, it does not include bass or inversion
 226
 227   Part of Chord:: namespace for now, because we do lots of
 228   chord-manipulating stuff.
 229 */
 230 SCM
 231 Chord::tonic_add_sub_to_pitches (SCM tonic, SCM add, SCM sub)
 232 {
 233   /* urg: catch dim modifier: 3rd, 5th, 7th, .. should be lowered */
 234   bool dim_b = false;
 235   for (SCM i = add; gh_pair_p (i); i = ly_cdr (i))
 236     {
 237       Pitch* p = unsmob_pitch (ly_car (i));
 238       /* Ugr
 239         This chord modifier stuff should really be fixed
 240        Cmaj7 yields C 7/7-
 241       */
 242       if (p->get_octave ()  == -100)
 243         {
 244           dim_b = true;
 245           Pitch t (0, p->get_notename(), p->get_alteration());
 246           gh_set_car_x (i, t.smobbed_copy());
 247           dim_b = true;
 248         }
 249     }
 250
 251   add = transpose_pitches (tonic, add);
 252   add = lower_step (tonic, add, scm_int2num (7));
 253   add = scm_sort_list (add, Pitch::less_p_proc);
 254   add = ly_unique (add);
 255
 256   sub = transpose_pitches (tonic, sub);
 257   sub = lower_step (tonic, sub, scm_int2num (7));
 258   sub = scm_sort_list (sub, Pitch::less_p_proc);
 259
 260   /* default chord includes upto 5: <1, 3, 5>   */
 261   add = gh_cons (tonic, add);
 262   SCM tmp = add;
 263
 264   SCM fifth = ly_last (base_pitches (tonic));
 265   int highest_step = gh_scm2int (step_scm (tonic, ly_last (tmp)));
 266   if (highest_step < 5)
 267     tmp = ly_snoc (fifth, tmp);
 268   else if (dim_b)
 269     {
 270       add = lower_step (tonic, add, scm_int2num (5));
 271       add = lower_step (tonic, add, scm_int2num (7));
 272     }
 273
 274   /* find missing thirds */
 275   SCM missing = missing_thirds (tmp);
 276   if (highest_step < 5)
 277     missing = ly_snoc (fifth, missing);
 278
 279   /* if dim modifier is given: lower all missing */
 280   if (dim_b)
 281     missing = lower_step (tonic, missing, scm_int2num (0));
 282
 283   /* if additions include any 3, don't add third */
 284   SCM third = ly_cadr (base_pitches (tonic));
 285   if (member_notename (third, add) != SCM_BOOL_F)
 286     missing = scm_delete (third, missing);
 287
 288   /* if additions include any 4, assume sus4 and don't add third implicitely
 289      C-sus (4) = c f g (1 4 5) */
 290   SCM sus = ly_pitch_transpose (tonic, Pitch (0, 3, 0).smobbed_copy ());
 291   if (member_notename (sus, add) != SCM_BOOL_F)
 292     missing = scm_delete (third, missing);
 293
 294   /* if additions include some 5, don't add fifth */
 295   if (member_notename (fifth, add) != SCM_BOOL_F)
 296     missing = scm_delete (fifth, missing);
 297
 298   /* complete the list of thirds to be added */
 299   add = gh_append2 (missing, add);
 300   add = scm_sort_list (add, Pitch::less_p_proc);
 301
 302   SCM pitches = SCM_EOL;
 303   /* Add all that aren't subtracted */
 304   for (SCM i = add; gh_pair_p (i); i = ly_cdr (i))
 305     {
 306       SCM p = ly_car (i);
 307       SCM s = member_notename (p, sub);
 308       if (s != SCM_BOOL_F)
 309         sub = scm_delete (s, sub);
 310       else
 311         pitches = gh_cons (p, pitches);
 312     }
 313   pitches = scm_sort_list (pitches, Pitch::less_p_proc);
 314
 315   for (SCM i = sub; gh_pair_p (i); i = ly_cdr (i))
 316     warning (_f ("invalid subtraction: not part of chord: %s",
 317                  unsmob_pitch (ly_car (i))->string ()));
 318
 319   return pitches;
 320 }
 321
 322
 323 /* --Het lijkt me dat dit in het paarse gedeelte moet. */
 324 Music *
 325 Chord::get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur)
 326 {
 327   SCM pitches = tonic_add_sub_to_pitches (tonic, add, sub);
 328   SCM list = SCM_EOL;
 329   if (inversion != SCM_EOL)
 330     {
 331       /* If inversion requested, check first if the note is part of chord */
 332       SCM s = member_pitch (inversion, pitches);
 333       if (s != SCM_BOOL_F)
 334         {
 335           /* Then, delete and add as base note, ie: the inversion */
 336           pitches = scm_delete (s, pitches);
 337           Music * n = make_music_by_name (ly_symbol2scm ("NoteEvent"));
 338           n->set_mus_property ("pitch", ly_car (add_below_tonic (s, pitches)));
 339           n->set_mus_property ("duration", dur);
 340           n->set_mus_property ("inversion", SCM_BOOL_T);
 341           list = gh_cons (n->self_scm (), list);
 342           scm_gc_unprotect_object (n->self_scm ());
 343         }
 344       else
 345         warning (_f ("invalid inversion pitch: not part of chord: %s",
 346                      unsmob_pitch (inversion)->string ()));
 347     }
 348
 349   /* Bass is easy, just add if requested */
 350   if (bass != SCM_EOL)
 351     {
 352       Music * n = make_music_by_name (ly_symbol2scm ("NoteEvent"));
 353       n->set_mus_property ("pitch", ly_car (add_below_tonic (bass, pitches)));
 354       n->set_mus_property ("duration", dur);
 355       n->set_mus_property ("bass", SCM_BOOL_T);
 356       list = gh_cons (n->self_scm (), list);
 357       scm_gc_unprotect_object (n->self_scm ());
 358     }
 359
 360   for (SCM i = pitches; gh_pair_p (i); i = ly_cdr (i))
 361     {
 362       Music * n = make_music_by_name(ly_symbol2scm ("NoteEvent"));
 363       n->set_mus_property ("pitch", ly_car (i));
 364       n->set_mus_property ("duration", dur);
 365       list = gh_cons (n->self_scm (), list);
 366       scm_gc_unprotect_object (n->self_scm ());
 367     }
 368
 369   Music * v = make_music_by_name(ly_symbol2scm ("EventChord"));
 370   v->set_mus_property ("elements", list);
 371
 372   return v;
 373 }
 374
 375