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_delete1 (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 SCM
  50 ly_last (SCM list)
  51 {
  52   return gh_car (scm_last_pair (list));
  53 }
  54
  55 /* tail add */
  56 SCM
  57 ly_snoc (SCM s, SCM list)
  58 {
  59   return gh_append2 (list, gh_list (s, SCM_UNDEFINED));
  60 }
  61
  62
  63 /* Split list at member s, removing s.
  64    Return (BEFORE . AFTER) */
  65 SCM
  66 ly_split_list (SCM s, SCM list)
  67 {
  68   SCM before = SCM_EOL;
  69   SCM after = list;
  70   for (; gh_pair_p (after);)
  71     {
  72       SCM i = gh_car (after);
  73       after = gh_cdr (after);
  74       if (gh_equal_p (i, s))
  75         break;
  76       before = gh_cons (i, before);
  77     }
  78   return gh_cons (gh_reverse (before), after);
  79 }
  80
  81
  82 /* Construct from list of pitches and requests:
  83
  84   (PITCHES . (INVERSION . BASS))
  85
  86
  87   Note, the pitches here, are all inclusive.
  88   We must identify tonic, filter-out (and maybe detect) inversion and bass. */
  89
  90 SCM
  91 Chord::pitches_and_requests_to_chord (SCM pitches,
  92                                       SCM tonic_req,
  93                                       SCM inversion_req,
  94                                       SCM bass_req,
  95                                       bool find_inversion_b)
  96 {
  97   pitches = scm_sort_list (pitches, Pitch::less_p_proc);
  98
  99   if (bass_req != SCM_EOL)
 100     {
 101       assert (unsmob_pitch (gh_car (pitches))->notename_i_
 102               == unsmob_pitch (bass_req)->notename_i_);
 103       pitches = gh_cdr (pitches);
 104     }
 105
 106   if (inversion_req != SCM_EOL)
 107     {
 108       assert (unsmob_pitch (gh_car (pitches))->notename_i_
 109               == unsmob_pitch (inversion_req)->notename_i_);
 110       /* huh ? */
 111       assert (tonic_req != SCM_EOL);
 112
 113       SCM tonic = member_notename (tonic_req, pitches);
 114       if (tonic != SCM_EOL)
 115         pitches = add_above_tonic (gh_car (pitches), gh_cdr (pitches));
 116     }
 117   else if (find_inversion_b)
 118     {
 119       SCM tonic = (tonic_req != SCM_EOL)
 120         ? member_notename (pitches, tonic_req)
 121         : guess_tonic (pitches);
 122
 123       if (tonic != SCM_EOL)
 124         pitches = add_above_tonic (gh_car (pitches), gh_cdr (pitches));
 125     }
 126
 127   if (tonic_req != SCM_EOL)
 128       assert (unsmob_pitch (gh_car (pitches))->notename_i_
 129               == unsmob_pitch (tonic_req)->notename_i_);
 130
 131   return gh_cons (pitches, gh_cons (inversion_req, bass_req));
 132 }
 133
 134 /*
 135   JUNKME.
 136   do something smarter.
 137   zoals?
 138  */
 139 SCM
 140 Chord::base_pitches (SCM tonic)
 141 {
 142   SCM base = SCM_EOL;
 143
 144   SCM major = Pitch (0, 2, 0).smobbed_copy ();
 145   SCM minor = Pitch (0, 2, -1).smobbed_copy ();
 146
 147   base = gh_cons (tonic, base);
 148   base = gh_cons (Pitch::transpose (gh_car (base), major), base);
 149   base = gh_cons (Pitch::transpose (gh_car (base), minor), base);
 150
 151   return gh_reverse (base);
 152 }
 153
 154 SCM
 155 Chord::transpose_pitches (SCM tonic, SCM pitches)
 156 {
 157   /* map?
 158      hoe doe je lambda in C?
 159   */
 160   SCM transposed = SCM_EOL;
 161   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 162     {
 163       transposed = gh_cons (Pitch::transpose (tonic, gh_car (i)),
 164                             transposed);
 165     }
 166   return gh_reverse (transposed);
 167 }
 168
 169 /*
 170   burp, in SCM duw je gewoon een (if (= (step x) 7) (...)) door pitches
 171
 172   Lower step STEP.
 173   If step == 0, lower all.
 174  */
 175 SCM
 176 Chord::lower_step (SCM tonic, SCM pitches, SCM step)
 177 {
 178   SCM lowered = SCM_EOL;
 179   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 180     {
 181       SCM p = gh_car (i);
 182       if (gh_equal_p (step_scm (tonic, gh_car (i)), step)
 183           || gh_scm2int (step) == 0)
 184         {
 185           p = Pitch::transpose (p, Pitch (0, 0, -1).smobbed_copy ());
 186         }
 187       lowered = gh_cons (p, lowered);
 188     }
 189   return gh_reverse (lowered);
 190 }
 191
 192 /* Return member that has same notename, disregarding octave or alterations */
 193 SCM
 194 Chord::member_notename (SCM p, SCM pitches)
 195 {
 196   /* If there's an exact match, make sure to return that */
 197   SCM member = gh_member (p, pitches);
 198   if (member == SCM_BOOL_F)
 199     {
 200       for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 201         {
 202           /*
 203             Urg, eindelijk gevonden: () != #f, kan maar niet aan wennen.
 204             Anders kon iets korter...
 205            */
 206           if (unsmob_pitch (p)->notename_i_
 207               == unsmob_pitch (gh_car (i))->notename_i_)
 208             {
 209               member = gh_car (i);
 210               break;
 211             }
 212         }
 213     }
 214   return member;
 215 }
 216
 217 /* Return member that has same notename and alteration, disregarding octave */
 218 SCM
 219 Chord::member_pitch (SCM p, SCM pitches)
 220 {
 221   /* If there's an exact match, make sure to return that */
 222   SCM member = gh_member (p, pitches);
 223   if (member == SCM_BOOL_F)
 224     {
 225       for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 226         {
 227           if (unsmob_pitch (p)->notename_i_
 228               == unsmob_pitch (gh_car (i))->notename_i_
 229               && unsmob_pitch (p)->alteration_i_
 230               == unsmob_pitch (gh_car (i))->alteration_i_)
 231             {
 232               member = gh_car (i);
 233               break;
 234             }
 235         }
 236     }
 237   return member;
 238 }
 239
 240
 241
 242 int
 243 Chord::step_i (Pitch tonic, Pitch p)
 244 {
 245   int i = p.notename_i_ - tonic.notename_i_
 246     + (p.octave_i ()  - tonic.octave_i () ) * 7;
 247   while (i < 0)
 248     i += 7;
 249   i++;
 250   return i;
 251 }
 252
 253 SCM
 254 Chord::step_scm (SCM tonic, SCM p)
 255 {
 256   return gh_int2scm (step_i (*unsmob_pitch (tonic), *unsmob_pitch (p)));
 257 }
 258
 259 /*
 260   Assuming that PITCHES is a chord, with tonic (CAR PITCHES), find
 261   missing thirds, only considering notenames.  Eg, for
 262
 263     PITCHES = c gis d'
 264
 265   return
 266
 267     MISSING = e b'
 268
 269 */
 270 SCM
 271 Chord::missing_thirds (SCM pitches)
 272 {
 273   SCM thirds = SCM_EOL;
 274
 275   /* is the third c-e, d-f, etc. small or large? */
 276   int minormajor_a[] = {0, -1, -1, 0, 0, -1, -1};
 277   for (int i=0; i < 7; i++)
 278     thirds = gh_cons (Pitch (0, 2, minormajor_a[i]).smobbed_copy (),
 279                       thirds);
 280   thirds = scm_vector (gh_reverse (thirds));
 281
 282   SCM tonic = gh_car (pitches);
 283   SCM last = tonic;
 284   SCM missing = SCM_EOL;
 285
 286   for (SCM i = pitches; gh_pair_p (i);)
 287     {
 288       SCM p = gh_car (i);
 289       int step = gh_scm2int (step_scm (tonic, p));
 290
 291       if (unsmob_pitch (last)->notename_i_ == unsmob_pitch (p)->notename_i_)
 292         {
 293           int third = (unsmob_pitch (last)->notename_i_
 294                        - unsmob_pitch (tonic)-> notename_i_ + 7) % 7;
 295           last = Pitch::transpose (last, scm_vector_ref (thirds, gh_int2scm (third)));
 296         }
 297
 298       if (step > gh_scm2int (step_scm (tonic, last)))
 299         {
 300           while (step > gh_scm2int (step_scm (tonic, last)))
 301             {
 302               missing = gh_cons (last, missing);
 303               int third = (unsmob_pitch (last)->notename_i_
 304                            - unsmob_pitch (tonic)->notename_i_ + 7) % 7;
 305               last = Pitch::transpose (last, scm_vector_ref (thirds,
 306                                                       gh_int2scm (third)));
 307             }
 308         }
 309       else
 310         {
 311           i = gh_cdr (i);
 312         }
 313     }
 314
 315   return lower_step (tonic, missing, gh_int2scm (7));
 316 }
 317
 318
 319 /* Mangle
 320
 321      (PITCHES . (INVERSION . BASS))
 322
 323  into full list of pitches.
 324
 325  This means:
 326    - delete INVERSION and add as lowest note of PITCHES
 327    - add BASS as lowest note of PITCHES */
 328
 329 SCM
 330 Chord::to_pitches (SCM chord)
 331 {
 332   SCM pitches = gh_car (chord);
 333   SCM modifiers = gh_cdr (chord);
 334   SCM inversion = gh_car (modifiers);
 335   SCM bass = gh_cdr (modifiers);
 336
 337   if (inversion != SCM_EOL)
 338     {
 339       /* If inversion requested, check first if the note is part of chord */
 340       SCM s = member_pitch (inversion, pitches);
 341       if (s != SCM_BOOL_F)
 342         {
 343           /* Then, delete and add as base note, ie: the inversion */
 344           scm_delete (s, pitches);
 345           pitches = add_below_tonic (s, pitches);
 346         }
 347       else
 348         warning (_f ("invalid inversion pitch: not part of chord: %s",
 349                      unsmob_pitch (inversion)->str ()));
 350     }
 351
 352   /* Bass is easy, just add if requested */
 353   if (bass != SCM_EOL)
 354     pitches = add_below_tonic (bass, pitches);
 355
 356   return pitches;
 357 }
 358
 359 /*
 360   This routine tries to guess tonic in a possibly inversed chord, ie
 361   <e g c'> should produce: C.
 362   This is only used for chords that are entered as simultaneous notes,
 363   chords entered in \chord mode are fully defined.
 364  */
 365
 366 SCM
 367 Chord::guess_tonic (SCM pitches)
 368 {
 369   return gh_car (scm_sort_list (pitches, Pitch::less_p_proc));
 370 }
 371
 372 /* Return PITCHES with PITCH added not as lowest note */
 373 SCM
 374 Chord::add_above_tonic (SCM pitch, SCM pitches)
 375 {
 376   /* Should we maybe first make sure that PITCH is below tonic? */
 377   if (pitches != SCM_EOL)
 378     while (Pitch::less_p (pitch, gh_car (pitches)) == SCM_BOOL_T)
 379       pitch = Pitch::transpose (pitch, Pitch (1, 0, 0).smobbed_copy ());
 380
 381   pitches = gh_cons (pitch, pitches);
 382   return scm_sort_list (pitches, Pitch::less_p_proc);
 383 }
 384
 385 /* Return PITCHES with PITCH added as lowest note */
 386 SCM
 387 Chord::add_below_tonic (SCM pitch, SCM pitches)
 388 {
 389   if (pitches != SCM_EOL)
 390     while (Pitch::less_p (gh_car (pitches), pitch) == SCM_BOOL_T)
 391       pitch = Pitch::transpose (pitch, Pitch (-1, 0, 0).smobbed_copy ());
 392   return gh_cons (pitch, pitches);
 393 }
 394
 395
 396
 397 /*****
 398       Parser stuff
 399
 400       Construct from parser output:
 401
 402       (PITCHES . (INVERSION . BASS))
 403
 404       PITCHES is the plain chord, it does not include bass or inversion
 405
 406       Part of Chord:: namespace for now, because we do lots of
 407       chord-manipulating stuff. */
 408
 409 SCM
 410 Chord::tonic_add_sub_inversion_bass_to_scm (SCM tonic, SCM add, SCM sub,
 411                                             SCM inversion, SCM bass)
 412 {
 413   /* urg: catch dim modifier: 3rd, 5th, 7th, .. should be lowered */
 414   bool dim_b = false;
 415   for (SCM i = add; gh_pair_p (i); i = gh_cdr (i))
 416     {
 417       Pitch* p = unsmob_pitch (gh_car (i));
 418       if (p->octave_i ()  == -100)
 419         {
 420           p->octave_i_ = 0;
 421           dim_b = true;
 422         }
 423     }
 424   add = transpose_pitches (tonic, add);
 425   add = lower_step (tonic, add, gh_int2scm (7));
 426   add = scm_sort_list (add, Pitch::less_p_proc);
 427   add = ly_unique (add);
 428
 429   sub = transpose_pitches (tonic, sub);
 430   sub = lower_step (tonic, sub, gh_int2scm (7));
 431   sub = scm_sort_list (sub, Pitch::less_p_proc);
 432
 433   /* default chord includes upto 5: <1, 3, 5>   */
 434   add = gh_cons (tonic, add);
 435   SCM tmp = add;
 436
 437   SCM fifth = ly_last (base_pitches (tonic));
 438   int highest_step = gh_scm2int (step_scm (tonic, ly_last (tmp)));
 439   if (highest_step < 5)
 440     tmp = ly_snoc (fifth, tmp);
 441   else if (dim_b)
 442     add = lower_step (tonic, add, gh_int2scm (5));
 443
 444   /* find missing thirds */
 445   SCM missing = missing_thirds (tmp);
 446   if (highest_step < 5)
 447     missing = ly_snoc (fifth, missing);
 448
 449   /* if dim modifier is given: lower all missing */
 450   if (dim_b)
 451     missing = lower_step (tonic, missing, gh_int2scm (0));
 452
 453   /* if additions include any 3, don't add third */
 454   SCM third = gh_cadr (base_pitches (tonic));
 455   if (member_notename (third, add) != SCM_BOOL_F)
 456     missing = scm_delete (third, missing);
 457
 458   /* if additions include any 4, assume sus4 and don't add third implicitely
 459      C-sus (4) = c f g (1 4 5) */
 460   SCM sus = Pitch::transpose (tonic, Pitch (0, 3, 0).smobbed_copy ());
 461   if (member_notename (sus, add) != SCM_BOOL_F)
 462     missing = scm_delete (third, missing);
 463
 464   /* if additions include some 5, don't add fifth */
 465   if (member_notename (fifth, add) != SCM_BOOL_F)
 466     missing = scm_delete (fifth, missing);
 467
 468   /* complete the list of thirds to be added */
 469   add = gh_append2 (missing, add);
 470   add = scm_sort_list (add, Pitch::less_p_proc);
 471
 472   SCM pitches = SCM_EOL;
 473   /* Add all that aren't subtracted */
 474   for (SCM i = add; gh_pair_p (i); i = gh_cdr (i))
 475     {
 476       SCM p = gh_car (i);
 477       SCM s = member_notename (p, sub);
 478       if (s != SCM_BOOL_F)
 479         sub = scm_delete (s, sub);
 480       else
 481         pitches = gh_cons (p, pitches);
 482     }
 483   pitches = scm_sort_list (pitches, Pitch::less_p_proc);
 484
 485   for (SCM i = sub; gh_pair_p (i); i = gh_cdr (i))
 486     warning (_f ("invalid subtraction: not part of chord: %s",
 487                  unsmob_pitch (gh_car (i))->str ()));
 488
 489   return gh_cons (pitches, gh_cons (inversion, bass));
 490 }
 491
 492
 493 /*
 494   --Het lijkt me dat dit in het paarse gedeelte moet.
 495
 496   Zo-en-zo, lijktme dat je ipv. Inversion_req een (inversion . #t) aan
 497   de betreffende Noot_req kan hangen
 498 */
 499
 500 Simultaneous_music *
 501 Chord::get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur)
 502 {
 503   SCM chord = tonic_add_sub_inversion_bass_to_scm (tonic, add, sub,
 504                                                    inversion, bass);
 505
 506   Tonic_req* t = new Tonic_req;
 507   t->set_mus_property ("pitch",  tonic);
 508   SCM l = gh_cons (t->self_scm (), SCM_EOL);
 509
 510   SCM modifiers = gh_cdr (chord);
 511   inversion = gh_car (modifiers);
 512   bass = gh_cdr (modifiers);
 513
 514   /* This sucks.
 515      Should add (inversion . #t) to the pitch that is an inversion
 516    */
 517   if (inversion != SCM_EOL)
 518     {
 519       Inversion_req* i = new Inversion_req;
 520       i->set_mus_property ("pitch",  inversion);
 521       l = gh_cons (i->self_scm (), l);
 522       scm_unprotect_object (i->self_scm ());
 523     }
 524
 525   /*
 526     Should add (base . #t) to the pitch that is an added base
 527    */
 528   if (bass != SCM_EOL)
 529     {
 530       Bass_req* b = new Bass_req;
 531       b->set_mus_property ("pitch", bass);
 532
 533       l = gh_cons (b->self_scm (), l);
 534       scm_unprotect_object (b->self_scm ());
 535     }
 536
 537   SCM pitches = Chord::to_pitches (chord);
 538   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 539     {
 540       Note_req* n = new Note_req;
 541       n->set_mus_property ("pitch", gh_car (i));
 542       n->set_mus_property ("duration", dur);
 543       l = gh_cons (n->self_scm (), l);
 544
 545       scm_unprotect_object (n->self_scm ());
 546     }
 547
 548   Simultaneous_music*v = new Request_chord (l);
 549
 550   return v;
 551 }
 552
 553