lily/chord.cc

   1 /*
   2   chord.cc -- implement Chord
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c)  1999--2000 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   return member;
 156 }
 157
 158 /* Return member that has same notename and alteration, disregarding octave */
 159 SCM
 160 Chord::member_pitch (SCM p, SCM pitches)
 161 {
 162   /* If there's an exact match, make sure to return that */
 163   SCM member = gh_member (p, pitches);
 164   if (member == SCM_BOOL_F)
 165     {
 166       for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 167         {
 168           if (unsmob_pitch (p)->notename_i_
 169               == unsmob_pitch (gh_car (i))->notename_i_
 170               && unsmob_pitch (p)->alteration_i_
 171               == unsmob_pitch (gh_car (i))->alteration_i_)
 172             {
 173               member = gh_car (i);
 174               break;
 175             }
 176         }
 177     }
 178   return member;
 179 }
 180
 181 SCM
 182 Chord::step_scm (SCM tonic, SCM p)
 183 {
 184   /* De Pitch intervaas is nog beetje sleutelgat? */
 185   int i = unsmob_pitch (p)->notename_i_
 186     - unsmob_pitch (tonic)->notename_i_
 187     + (unsmob_pitch (p)->octave_i_
 188        - unsmob_pitch (tonic)->octave_i_ ) * 7;
 189   while (i < 0)
 190     i += 7;
 191   i++;
 192   return gh_int2scm (i);
 193 }
 194
 195 /*
 196   Assuming that PITCHES is a chord, with tonic (CAR PITCHES), find
 197   missing thirds, only considering notenames.  Eg, for
 198
 199     PITCHES = c gis d'
 200
 201   return
 202
 203     MISSING = e b'
 204
 205 */
 206 SCM
 207 Chord::missing_thirds (SCM pitches)
 208 {
 209   SCM thirds = SCM_EOL;
 210
 211   /* is the third c-e, d-f, etc. small or large? */
 212   int minormajor_a[] = {0, -1, -1, 0, 0, -1, -1};
 213   for (int i=0; i < 7; i++)
 214     thirds = gh_cons (Pitch (0, 2, minormajor_a[i]).smobbed_copy (),
 215                       thirds);
 216   thirds = scm_vector (gh_reverse (thirds));
 217
 218   SCM tonic = gh_car (pitches);
 219   SCM last = tonic;
 220   SCM missing = SCM_EOL;
 221
 222   for (SCM i = pitches; gh_pair_p (i);)
 223     {
 224       SCM p = gh_car (i);
 225       int step = gh_scm2int (step_scm (tonic, p));
 226
 227       if (unsmob_pitch (last)->notename_i_ == unsmob_pitch (p)->notename_i_)
 228         {
 229           int third = (unsmob_pitch (last)->notename_i_
 230                        - unsmob_pitch (tonic)-> notename_i_ + 7) % 7;
 231           last = Pitch::transpose (last, scm_vector_ref (thirds, gh_int2scm (third)));
 232         }
 233
 234       if (step > gh_scm2int (step_scm (tonic, last)))
 235         {
 236           while (step > gh_scm2int (step_scm (tonic, last)))
 237             {
 238               missing = gh_cons (last, missing);
 239               int third = (unsmob_pitch (last)->notename_i_
 240                            - unsmob_pitch (tonic)->notename_i_ + 7) % 7;
 241               last = Pitch::transpose (last, scm_vector_ref (thirds,
 242                                                       gh_int2scm (third)));
 243             }
 244         }
 245       else
 246         {
 247           i = gh_cdr (i);
 248         }
 249     }
 250
 251   return lower_step (tonic, missing, gh_int2scm (7));
 252 }
 253
 254 /* Return PITCHES with PITCH added not as lowest note */
 255 SCM
 256 Chord::add_above_tonic (SCM pitch, SCM pitches)
 257 {
 258   /* Should we maybe first make sure that PITCH is below tonic? */
 259   if (pitches != SCM_EOL)
 260     while (Pitch::less_p (pitch, gh_car (pitches)) == SCM_BOOL_T)
 261       pitch = Pitch::transpose (pitch, Pitch (1, 0, 0).smobbed_copy ());
 262
 263   pitches = gh_cons (pitch, pitches);
 264   return scm_sort_list (pitches, Pitch::less_p_proc);
 265 }
 266
 267 /* Return PITCHES with PITCH added as lowest note */
 268 SCM
 269 Chord::add_below_tonic (SCM pitch, SCM pitches)
 270 {
 271   if (pitches != SCM_EOL)
 272     while (Pitch::less_p (gh_car (pitches), pitch) == SCM_BOOL_T)
 273       pitch = Pitch::transpose (pitch, Pitch (-1, 0, 0).smobbed_copy ());
 274   return gh_cons (pitch, pitches);
 275 }
 276
 277
 278
 279 /*
 280   Parser stuff
 281
 282   Construct from parser output:
 283
 284   PITCHES is the plain chord, it does not include bass or inversion
 285
 286   Part of Chord:: namespace for now, because we do lots of
 287   chord-manipulating stuff.
 288 */
 289 SCM
 290 Chord::tonic_add_sub_to_pitches (SCM tonic, SCM add, SCM sub)
 291 {
 292   /* urg: catch dim modifier: 3rd, 5th, 7th, .. should be lowered */
 293   bool dim_b = false;
 294   for (SCM i = add; gh_pair_p (i); i = gh_cdr (i))
 295     {
 296       Pitch* p = unsmob_pitch (gh_car (i));
 297       if (p->octave_i ()  == -100)
 298         {
 299           p->octave_i_ = 0;
 300           dim_b = true;
 301         }
 302     }
 303   add = transpose_pitches (tonic, add);
 304   add = lower_step (tonic, add, gh_int2scm (7));
 305   add = scm_sort_list (add, Pitch::less_p_proc);
 306   add = ly_unique (add);
 307
 308   sub = transpose_pitches (tonic, sub);
 309   sub = lower_step (tonic, sub, gh_int2scm (7));
 310   sub = scm_sort_list (sub, Pitch::less_p_proc);
 311
 312   /* default chord includes upto 5: <1, 3, 5>   */
 313   add = gh_cons (tonic, add);
 314   SCM tmp = add;
 315
 316   SCM fifth = ly_last (base_pitches (tonic));
 317   int highest_step = gh_scm2int (step_scm (tonic, ly_last (tmp)));
 318   if (highest_step < 5)
 319     tmp = ly_snoc (fifth, tmp);
 320   else if (dim_b)
 321     add = lower_step (tonic, add, gh_int2scm (5));
 322
 323   /* find missing thirds */
 324   SCM missing = missing_thirds (tmp);
 325   if (highest_step < 5)
 326     missing = ly_snoc (fifth, missing);
 327
 328   /* if dim modifier is given: lower all missing */
 329   if (dim_b)
 330     missing = lower_step (tonic, missing, gh_int2scm (0));
 331
 332   /* if additions include any 3, don't add third */
 333   SCM third = gh_cadr (base_pitches (tonic));
 334   if (member_notename (third, add) != SCM_BOOL_F)
 335     missing = scm_delete (third, missing);
 336
 337   /* if additions include any 4, assume sus4 and don't add third implicitely
 338      C-sus (4) = c f g (1 4 5) */
 339   SCM sus = Pitch::transpose (tonic, Pitch (0, 3, 0).smobbed_copy ());
 340   if (member_notename (sus, add) != SCM_BOOL_F)
 341     missing = scm_delete (third, missing);
 342
 343   /* if additions include some 5, don't add fifth */
 344   if (member_notename (fifth, add) != SCM_BOOL_F)
 345     missing = scm_delete (fifth, missing);
 346
 347   /* complete the list of thirds to be added */
 348   add = gh_append2 (missing, add);
 349   add = scm_sort_list (add, Pitch::less_p_proc);
 350
 351   SCM pitches = SCM_EOL;
 352   /* Add all that aren't subtracted */
 353   for (SCM i = add; gh_pair_p (i); i = gh_cdr (i))
 354     {
 355       SCM p = gh_car (i);
 356       SCM s = member_notename (p, sub);
 357       if (s != SCM_BOOL_F)
 358         sub = scm_delete (s, sub);
 359       else
 360         pitches = gh_cons (p, pitches);
 361     }
 362   pitches = scm_sort_list (pitches, Pitch::less_p_proc);
 363
 364   for (SCM i = sub; gh_pair_p (i); i = gh_cdr (i))
 365     warning (_f ("invalid subtraction: not part of chord: %s",
 366                  unsmob_pitch (gh_car (i))->str ()));
 367
 368   return pitches;
 369 }
 370
 371
 372 /* --Het lijkt me dat dit in het paarse gedeelte moet. */
 373 Simultaneous_music *
 374 Chord::get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur)
 375 {
 376   SCM pitches = tonic_add_sub_to_pitches (tonic, add, sub);
 377   SCM list = SCM_EOL;
 378   if (inversion != SCM_EOL)
 379     {
 380       /* If inversion requested, check first if the note is part of chord */
 381       SCM s = member_pitch (inversion, pitches);
 382       if (s != SCM_BOOL_F)
 383         {
 384           /* Then, delete and add as base note, ie: the inversion */
 385           pitches = scm_delete (s, pitches);
 386           Note_req* n = new Note_req;
 387           n->set_mus_property ("pitch", gh_car (add_below_tonic (s, pitches)));
 388           n->set_mus_property ("duration", dur);
 389           n->set_mus_property ("inversion", SCM_BOOL_T);
 390           list = gh_cons (n->self_scm (), list);
 391           scm_unprotect_object (n->self_scm ());
 392         }
 393       else
 394         warning (_f ("invalid inversion pitch: not part of chord: %s",
 395                      unsmob_pitch (inversion)->str ()));
 396     }
 397
 398   /* Bass is easy, just add if requested */
 399   if (bass != SCM_EOL)
 400     {
 401       Note_req* n = new Note_req;
 402       n->set_mus_property ("pitch", gh_car (add_below_tonic (bass, pitches)));
 403       n->set_mus_property ("duration", dur);
 404       n->set_mus_property ("bass", SCM_BOOL_T);
 405       list = gh_cons (n->self_scm (), list);
 406       scm_unprotect_object (n->self_scm ());
 407     }
 408
 409   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 410     {
 411       Note_req* n = new Note_req;
 412       n->set_mus_property ("pitch", gh_car (i));
 413       n->set_mus_property ("duration", dur);
 414       list = gh_cons (n->self_scm (), list);
 415       scm_unprotect_object (n->self_scm ());
 416     }
 417
 418   Simultaneous_music*v = new Request_chord (list);
 419
 420   return v;
 421 }
 422
 423