lily/chord.cc

   1 /*
   2   chord.cc -- implement Chord
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1999--2001 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 = gh_cdr (i))
  28     {
  29       if (!gh_pair_p (gh_cdr (i))
  30           || !gh_equal_p (gh_car (i), gh_cadr (i)))
  31         unique = gh_cons (gh_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 = gh_cdr (i))
  42     {
  43       if (!gh_equal_p (gh_car (i), s))
  44         removed = gh_cons (gh_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, gh_list (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 = gh_car (after);
  67       after = gh_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 (gh_car (base), major), base);
  90   base = gh_cons (Pitch::transpose (gh_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 = gh_cdr (i))
 103     {
 104       transposed = gh_cons (Pitch::transpose (tonic, gh_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 = gh_cdr (i))
 121     {
 122       SCM p = gh_car (i);
 123       if (gh_equal_p (step_scm (tonic, gh_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 = gh_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 (gh_car (i))->notename_i_)
 149             {
 150               member = gh_car (i);
 151               break;
 152             }
 153         }
 154     }
 155   else
 156     member = gh_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 = gh_cdr (i))
 169         {
 170           if (unsmob_pitch (p)->notename_i_
 171               == unsmob_pitch (gh_car (i))->notename_i_
 172               && unsmob_pitch (p)->alteration_i_
 173               == unsmob_pitch (gh_car (i))->alteration_i_)
 174             {
 175               member = gh_car (i);
 176               break;
 177             }
 178         }
 179     }
 180   else
 181     member = gh_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 = gh_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 = gh_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 = gh_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, gh_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 (gh_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 = gh_cdr (i))
 299     {
 300       Pitch* p = unsmob_pitch (gh_car (i));
 301       if (p->octave_i ()  == -100)
 302         {
 303           p->octave_i_ = 0;
 304           dim_b = true;
 305         }
 306     }
 307   add = transpose_pitches (tonic, add);
 308   add = lower_step (tonic, add, gh_int2scm (7));
 309   add = scm_sort_list (add, Pitch::less_p_proc);
 310   add = ly_unique (add);
 311
 312   sub = transpose_pitches (tonic, sub);
 313   sub = lower_step (tonic, sub, gh_int2scm (7));
 314   sub = scm_sort_list (sub, Pitch::less_p_proc);
 315
 316   /* default chord includes upto 5: <1, 3, 5>   */
 317   add = gh_cons (tonic, add);
 318   SCM tmp = add;
 319
 320   SCM fifth = ly_last (base_pitches (tonic));
 321   int highest_step = gh_scm2int (step_scm (tonic, ly_last (tmp)));
 322   if (highest_step < 5)
 323     tmp = ly_snoc (fifth, tmp);
 324   else if (dim_b)
 325     add = lower_step (tonic, add, gh_int2scm (5));
 326
 327   /* find missing thirds */
 328   SCM missing = missing_thirds (tmp);
 329   if (highest_step < 5)
 330     missing = ly_snoc (fifth, missing);
 331
 332   /* if dim modifier is given: lower all missing */
 333   if (dim_b)
 334     missing = lower_step (tonic, missing, gh_int2scm (0));
 335
 336   /* if additions include any 3, don't add third */
 337   SCM third = gh_cadr (base_pitches (tonic));
 338   if (member_notename (third, add) != SCM_BOOL_F)
 339     missing = scm_delete (third, missing);
 340
 341   /* if additions include any 4, assume sus4 and don't add third implicitely
 342      C-sus (4) = c f g (1 4 5) */
 343   SCM sus = Pitch::transpose (tonic, Pitch (0, 3, 0).smobbed_copy ());
 344   if (member_notename (sus, add) != SCM_BOOL_F)
 345     missing = scm_delete (third, missing);
 346
 347   /* if additions include some 5, don't add fifth */
 348   if (member_notename (fifth, add) != SCM_BOOL_F)
 349     missing = scm_delete (fifth, missing);
 350
 351   /* complete the list of thirds to be added */
 352   add = gh_append2 (missing, add);
 353   add = scm_sort_list (add, Pitch::less_p_proc);
 354
 355   SCM pitches = SCM_EOL;
 356   /* Add all that aren't subtracted */
 357   for (SCM i = add; gh_pair_p (i); i = gh_cdr (i))
 358     {
 359       SCM p = gh_car (i);
 360       SCM s = member_notename (p, sub);
 361       if (s != SCM_BOOL_F)
 362         sub = scm_delete (s, sub);
 363       else
 364         pitches = gh_cons (p, pitches);
 365     }
 366   pitches = scm_sort_list (pitches, Pitch::less_p_proc);
 367
 368   for (SCM i = sub; gh_pair_p (i); i = gh_cdr (i))
 369     warning (_f ("invalid subtraction: not part of chord: %s",
 370                  unsmob_pitch (gh_car (i))->str ()));
 371
 372   return pitches;
 373 }
 374
 375
 376 /* --Het lijkt me dat dit in het paarse gedeelte moet. */
 377 Simultaneous_music *
 378 Chord::get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur)
 379 {
 380   SCM pitches = tonic_add_sub_to_pitches (tonic, add, sub);
 381   SCM list = SCM_EOL;
 382   if (inversion != SCM_EOL)
 383     {
 384       /* If inversion requested, check first if the note is part of chord */
 385       SCM s = member_pitch (inversion, pitches);
 386       if (s != SCM_BOOL_F)
 387         {
 388           /* Then, delete and add as base note, ie: the inversion */
 389           pitches = scm_delete (s, pitches);
 390           Note_req* n = new Note_req;
 391           n->set_mus_property ("pitch", gh_car (add_below_tonic (s, pitches)));
 392           n->set_mus_property ("duration", dur);
 393           n->set_mus_property ("inversion", SCM_BOOL_T);
 394           list = gh_cons (n->self_scm (), list);
 395           scm_unprotect_object (n->self_scm ());
 396         }
 397       else
 398         warning (_f ("invalid inversion pitch: not part of chord: %s",
 399                      unsmob_pitch (inversion)->str ()));
 400     }
 401
 402   /* Bass is easy, just add if requested */
 403   if (bass != SCM_EOL)
 404     {
 405       Note_req* n = new Note_req;
 406       n->set_mus_property ("pitch", gh_car (add_below_tonic (bass, pitches)));
 407       n->set_mus_property ("duration", dur);
 408       n->set_mus_property ("bass", SCM_BOOL_T);
 409       list = gh_cons (n->self_scm (), list);
 410       scm_unprotect_object (n->self_scm ());
 411     }
 412
 413   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 414     {
 415       Note_req* n = new Note_req;
 416       n->set_mus_property ("pitch", gh_car (i));
 417       n->set_mus_property ("duration", dur);
 418       list = gh_cons (n->self_scm (), list);
 419       scm_unprotect_object (n->self_scm ());
 420     }
 421
 422   Simultaneous_music*v = new Request_chord (SCM_EOL);
 423   v->set_mus_property ("elements", list);
 424
 425   return v;
 426 }
 427
 428