lily/chord.cc

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