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 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,
  98                            scm_eval2 (ly_symbol2scm ("Pitch::less_p"),
  99                                       SCM_EOL));
 100
 101
 102   if (bass_req != SCM_EOL)
 103     {
 104       assert (unsmob_pitch (gh_car (pitches))->notename_i_
 105               == unsmob_pitch (bass_req)->notename_i_);
 106       pitches = gh_cdr (pitches);
 107     }
 108
 109   if (inversion_req != SCM_EOL)
 110     {
 111       assert (unsmob_pitch (gh_car (pitches))->notename_i_
 112               == unsmob_pitch (inversion_req)->notename_i_);
 113       /* huh ? */
 114       assert (tonic_req != SCM_EOL);
 115
 116       SCM tonic = member_notename (tonic_req, pitches);
 117       if (tonic != SCM_EOL)
 118         pitches = rebuild_insert_inversion (pitches); //, tonic);
 119     }
 120   else if (find_inversion_b)
 121     {
 122       SCM tonic = (tonic_req != SCM_EOL)
 123         ? member_notename (pitches, tonic_req)
 124         : guess_tonic (pitches);
 125
 126       if (tonic != SCM_EOL)
 127         {
 128           inversion_req = gh_car (pitches);
 129           pitches = rebuild_insert_inversion (pitches); //, tonic);
 130         }
 131     }
 132
 133   if (tonic_req != SCM_EOL)
 134       assert (unsmob_pitch (gh_car (pitches))->notename_i_
 135               == unsmob_pitch (tonic_req)->notename_i_);
 136
 137   return gh_cons (pitches, gh_cons (inversion_req, bass_req));
 138 }
 139
 140 /*
 141   JUNKME.
 142   do something smarter.
 143   zoals?
 144  */
 145 SCM
 146 Chord::base_pitches (SCM tonic)
 147 {
 148   SCM base = SCM_EOL;
 149
 150   SCM major = Pitch (0, 2, 0).smobbed_copy ();
 151   SCM minor = Pitch (0, 2, -1).smobbed_copy ();
 152
 153   base = gh_cons (tonic, base);
 154   base = gh_cons (Pitch::transpose (gh_car (base), major), base);
 155   base = gh_cons (Pitch::transpose (gh_car (base), minor), base);
 156
 157   return gh_reverse (base);
 158 }
 159
 160 SCM
 161 Chord::transpose_pitches (SCM tonic, SCM pitches)
 162 {
 163   /* map?
 164      hoe doe je lambda in C?
 165   */
 166   SCM transposed = SCM_EOL;
 167   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 168     {
 169       transposed = gh_cons (Pitch::transpose (tonic, gh_car (i)),
 170                             transposed);
 171     }
 172   return gh_reverse (transposed);
 173 }
 174
 175 /*
 176   burp, in SCM duw je gewoon een (if (= (step x) 7) (...)) door pitches
 177
 178   Lower step STEP.
 179   If step == 0, lower all.
 180  */
 181 SCM
 182 Chord::lower_step (SCM tonic, SCM pitches, SCM step)
 183 {
 184   SCM lowered = SCM_EOL;
 185   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 186     {
 187       SCM p = gh_car (i);
 188       if (gh_equal_p (step_scm (tonic, gh_car (i)), step)
 189           || gh_scm2int (step) == 0)
 190         {
 191 #if 0
 192           Pitch x = *unsmob_pitch (p);
 193           x.alteration_i_--;
 194           p = x.smobbed_copy ();
 195 #else
 196           p = Pitch::transpose (p, Pitch (0, 0, -1).smobbed_copy ());
 197 #endif
 198         }
 199       lowered = gh_cons (p, lowered);
 200     }
 201   return gh_reverse (lowered);
 202 }
 203
 204 /* Return member that has same notename, disregarding octave or accidentals */
 205 SCM
 206 Chord::member_notename (SCM p, SCM pitches)
 207 {
 208   /* If there's an exact match, make sure to return that */
 209   SCM member = gh_member (p, pitches);
 210   if (member == SCM_BOOL_F)
 211     {
 212       for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 213         {
 214           /*
 215             Urg, eindelijk gevonden: () != #f, kan maar niet aan wennen.
 216             Anders kon iets korter...
 217            */
 218           if (unsmob_pitch (p)->notename_i_
 219               == unsmob_pitch (gh_car (i))->notename_i_)
 220             {
 221               member = gh_car (i);
 222               break;
 223             }
 224         }
 225     }
 226   return member;
 227 }
 228
 229 int
 230 Chord::step_i (Pitch tonic, Pitch p)
 231 {
 232   int i = p.notename_i_ - tonic.notename_i_
 233     + (p.octave_i ()  - tonic.octave_i () ) * 7;
 234   while (i < 0)
 235     i += 7;
 236   i++;
 237   return i;
 238 }
 239
 240 SCM
 241 Chord::step_scm (SCM tonic, SCM p)
 242 {
 243   return gh_int2scm (step_i (*unsmob_pitch (tonic), *unsmob_pitch (p)));
 244 }
 245
 246 /*
 247   docme
 248  */
 249 SCM
 250 Chord::missing_thirds (SCM pitches)
 251 {
 252   SCM thirds = SCM_EOL;
 253
 254   /* is the third c-e, d-f, etc. small or large? */
 255   int minormajor_a[] = {0, -1, -1, 0, 0, -1, -1};
 256   for (int i=0; i < 7; i++)
 257     thirds = gh_cons (Pitch (0, 2, minormajor_a[i]).smobbed_copy (),
 258                       thirds);
 259   thirds = scm_vector (gh_reverse (thirds));
 260
 261   SCM tonic = gh_car (pitches);
 262   SCM last = tonic;
 263   SCM missing = SCM_EOL;
 264
 265   for (SCM i = pitches; gh_pair_p (i);)
 266     {
 267       SCM p = gh_car (i);
 268       int step = gh_scm2int (step_scm (tonic, p));
 269
 270       if (unsmob_pitch (last)->notename_i_ == unsmob_pitch (p)->notename_i_)
 271         {
 272           int third = (unsmob_pitch (last)->notename_i_
 273                        - unsmob_pitch (tonic)-> notename_i_ + 7) % 7;
 274           last = Pitch::transpose (last, scm_vector_ref (thirds, gh_int2scm (third)));
 275         }
 276
 277       if (step > gh_scm2int (step_scm (tonic, last)))
 278         {
 279           while (step > gh_scm2int (step_scm (tonic, last)))
 280             {
 281               missing = gh_cons (last, missing);
 282               int third = (unsmob_pitch (last)->notename_i_
 283                            - unsmob_pitch (tonic)->notename_i_ + 7) % 7;
 284               last = Pitch::transpose (last, scm_vector_ref (thirds,
 285                                                       gh_int2scm (third)));
 286             }
 287         }
 288       else
 289         {
 290           i = gh_cdr (i);
 291         }
 292     }
 293
 294   return lower_step (tonic, missing, gh_int2scm (7));
 295 }
 296
 297
 298 /*
 299  Mangle
 300
 301  (PITCHES . (INVERSION . BASS))
 302
 303  into list of pitches.
 304
 305  For normal chord entry, inversion and bass pitches are retained in
 306  specific *_requests */
 307
 308 SCM
 309 Chord::to_pitches (SCM chord)
 310 {
 311   SCM pitches = gh_car (chord);
 312   SCM modifiers = gh_cdr (chord);
 313   SCM inversion = gh_car (modifiers);
 314   SCM bass = gh_cdr (modifiers);
 315   if (inversion != SCM_EOL)
 316     {
 317       Pitch inversion_pitch = *unsmob_pitch (inversion);
 318       SCM i = pitches;
 319       for (; gh_pair_p (i); i = gh_cdr (i))
 320         {
 321           Pitch p = *unsmob_pitch (gh_car (i));
 322           if ((p.notename_i_ == inversion_pitch.notename_i_)
 323               && (p.alteration_i_ == inversion_pitch.alteration_i_))
 324             break;
 325         }
 326       if (gh_pair_p (i))
 327         pitches = rebuild_with_bass (pitches, gh_car (i));
 328       else
 329         warning (_f ("invalid inversion pitch: not part of chord: %s",
 330                      unsmob_pitch (inversion)->str ()));
 331     }
 332
 333   if (bass != SCM_EOL)
 334     {
 335       pitches = gh_cons (bass, pitches);
 336       pitches = rebuild_with_bass (pitches, bass);
 337     }
 338   return pitches;
 339 }
 340
 341 /*
 342   This routine tries to guess tonic in a possibly inversed chord, ie
 343   <e g c'> should produce: C.
 344   This is only used for chords that are entered as simultaneous notes,
 345   chords entered in \chord mode are fully defined.
 346  */
 347
 348 SCM
 349 Chord::guess_tonic (SCM pitches)
 350 {
 351   return gh_car (scm_sort_list (pitches, Pitch::less_p_proc));
 352 }
 353
 354 SCM
 355 Chord::rebuild_from_base (SCM pitches, SCM base)
 356 {
 357   SCM split = ly_split_list (base, pitches);
 358   SCM before = gh_car (split);
 359   SCM after = gh_cdr (split);
 360
 361   SCM last = Pitch (0, 0, -5).smobbed_copy ();
 362   SCM rebuilt = SCM_EOL;
 363   rebuilt = gh_cons (base, rebuilt);
 364   for (SCM i = gh_append2 (after, before); gh_pair_p (i); i = gh_cdr (i))
 365     {
 366       SCM p = gh_car (i);
 367       if (Pitch::less_p (p, last) == SCM_BOOL_T)
 368         {
 369           // UHUHUrg
 370           p = Pitch (unsmob_pitch (last)->octave_i_,
 371                              unsmob_pitch (p)->notename_i_,
 372                              unsmob_pitch (p)->alteration_i_).smobbed_copy ();
 373           if (Pitch::less_p (p, last))
 374             p = Pitch::transpose (p, Pitch (1, 0, 0).smobbed_copy ());
 375         }
 376       rebuilt = gh_cons (p, rebuilt);
 377       last = p;
 378     }
 379
 380   return gh_reverse (rebuilt);
 381 }
 382
 383 SCM
 384 Chord::rebuild_insert_inversion (SCM pitches) //, SCM tonic)
 385 {
 386   SCM inversion = gh_car (pitches);
 387   pitches = gh_cdr (pitches);
 388   SCM tonic = gh_car (pitches);
 389   pitches = rebuild_from_base (pitches, tonic);
 390   if (pitches != SCM_EOL)
 391     {
 392       // UHUHUrg
 393       inversion = Pitch (unsmob_pitch (gh_car (pitches))->octave_i_-1,
 394                                  unsmob_pitch (inversion)->notename_i_,
 395                                  unsmob_pitch (inversion)->alteration_i_).smobbed_copy ();
 396       while (Pitch::less_p (inversion, gh_car (pitches)) == SCM_BOOL_T)
 397         inversion = Pitch::transpose (inversion, Pitch (1, 0, 0).smobbed_copy ());
 398     }
 399   pitches = gh_cons (inversion, pitches);
 400   return scm_sort_list (pitches,
 401                         scm_eval2 (ly_symbol2scm ("Pitch::less_p"),
 402                                    SCM_EOL));
 403 }
 404
 405 SCM
 406 Chord::rebuild_with_bass (SCM pitches, SCM bass)
 407 {
 408   pitches = ly_remove_member (bass, pitches);
 409   // is lowering fine, or should others be raised?
 410   if (pitches != SCM_EOL)
 411     while (Pitch::less_p (gh_car (pitches), bass) == SCM_BOOL_T)
 412       bass = Pitch::transpose (bass, Pitch (-1, 0, 0).smobbed_copy ());
 413   return gh_cons (bass, pitches);
 414 }
 415
 416
 417
 418 /*********************************/
 419 /* Parser stuff */
 420
 421 /* Construct from parser output:
 422
 423   (PITCHES . (INVERSION . BASS)) */
 424 SCM
 425 Chord::tonic_add_sub_inversion_bass_to_scm (SCM tonic, SCM add, SCM sub,
 426                                             SCM inversion, SCM bass)
 427 {
 428   SCM less = scm_eval2 (ly_symbol2scm ("Pitch::less_p"), SCM_EOL);
 429
 430   /* urg: catch dim modifier: 3rd, 5th, 7th, .. should be lowered */
 431   bool dim_b = false;
 432   for (SCM i = add; gh_pair_p (i); i = gh_cdr (i))
 433     {
 434       Pitch* p = unsmob_pitch (gh_car (i));
 435       if (p->octave_i ()  == -100)
 436         {
 437           p->octave_i_ = 0;
 438           dim_b = true;
 439         }
 440     }
 441   add = transpose_pitches (tonic, add);
 442   add = lower_step (tonic, add, gh_int2scm (7));
 443   add = scm_sort_list (add, less);
 444   add = ly_unique (add);
 445
 446   sub = transpose_pitches (tonic, sub);
 447   sub = lower_step (tonic, sub, gh_int2scm (7));
 448   sub = scm_sort_list (sub, less);
 449
 450   /* default chord includes upto 5: <1, 3, 5>   */
 451   add = gh_cons (tonic, add);
 452   SCM tmp = add;
 453
 454   SCM fifth = ly_last (base_pitches (tonic));
 455   int highest_step = gh_scm2int (step_scm (tonic, ly_last (tmp)));
 456   if (highest_step < 5)
 457     tmp = ly_snoc (fifth, tmp);
 458   else if (dim_b)
 459     add = lower_step (tonic, add, gh_int2scm (5));
 460
 461   /* find missing thirds */
 462   SCM missing = missing_thirds (tmp);
 463   if (highest_step < 5)
 464     missing = ly_snoc (fifth, missing);
 465
 466   /* if dim modifier is given: lower all missing */
 467   if (dim_b)
 468     missing = lower_step (tonic, missing, gh_int2scm (0));
 469
 470   /* if additions include any 3, don't add third */
 471   SCM third = gh_cadr (base_pitches (tonic));
 472   if (member_notename (third, add) != SCM_BOOL_F)
 473     missing = ly_remove_member (third, missing);
 474
 475   /* if additions include any 4, assume sus4 and don't add third implicitely
 476      C-sus (4) = c f g (1 4 5) */
 477   SCM sus = Pitch::transpose (tonic, Pitch (0, 3, 0).smobbed_copy ());
 478   if (member_notename (sus, add) != SCM_BOOL_F)
 479     missing = ly_remove_member (third, missing);
 480
 481   /* if additions include some 5, don't add fifth */
 482   if (member_notename (fifth, add) != SCM_BOOL_F)
 483     missing = ly_remove_member (fifth, missing);
 484
 485   /* complete the list of thirds to be added */
 486   add = gh_append2 (missing, add);
 487   add = scm_sort_list (add, less);
 488
 489   SCM pitches = SCM_EOL;
 490   /* Add all that aren't subtracted */
 491   for (SCM i = add; gh_pair_p (i); i = gh_cdr (i))
 492     {
 493       SCM p = gh_car (i);
 494       SCM s = member_notename (p, sub);
 495       if (s != SCM_BOOL_F)
 496         sub = ly_remove_member (s, sub);
 497       else
 498         pitches = gh_cons (p, pitches);
 499     }
 500   pitches = scm_sort_list (pitches, less);
 501
 502   for (SCM i = sub; gh_pair_p (i); i = gh_cdr (i))
 503     warning (_f ("invalid subtraction: not part of chord: %s",
 504                  unsmob_pitch (gh_car (i))->str ()));
 505
 506   return gh_cons (pitches, gh_cons (inversion, bass));
 507 }
 508
 509
 510 /*
 511   junk me
 512
 513   snapnie
 514
 515   Een chord invoer bestaat uit een naam.  Maar, we willen een aantal
 516   pitch-requests doen, zodat na het parsen van een chord geen verschil
 517   meer is met een gewoon accoord.  Die vertaalslag is behoorlijk
 518   harig, hoe wil je dit junken?  Nouja, cleanup lijkt me aardige
 519   eerste stap enniewee.
 520
 521
 522   --Het lijkt me dat dit in het paarse gedeelte moet.
 523
 524   Zo-en-zo, lijktme dat je ipv. Inversion_req een (inversion . #t) aan
 525   de betreffende Noot_req kan hangen
 526 */
 527
 528 Simultaneous_music *
 529 Chord::get_chord (SCM tonic, SCM add, SCM sub, SCM inversion, SCM bass, SCM dur)
 530 {
 531   SCM chord = tonic_add_sub_inversion_bass_to_scm (tonic, add, sub,
 532                                                    inversion, bass);
 533
 534   Tonic_req* t = new Tonic_req;
 535   t->set_mus_property ("pitch",  tonic);
 536   SCM l = gh_cons (t->self_scm (), SCM_EOL);
 537
 538   SCM modifiers = gh_cdr (chord);
 539   inversion = gh_car (modifiers);
 540   bass = gh_cdr (modifiers);
 541
 542   //urg
 543   if (inversion != SCM_EOL)
 544     {
 545       Inversion_req* i = new Inversion_req;
 546       i->set_mus_property ("pitch",  inversion);
 547       l = gh_cons (i->self_scm (), l);
 548       scm_unprotect_object (i->self_scm ());
 549     }
 550
 551   if (bass != SCM_EOL)
 552     {
 553       Bass_req* b = new Bass_req;
 554       b->set_mus_property ("pitch", bass);
 555
 556       l = gh_cons (b->self_scm (), l);
 557       scm_unprotect_object (b->self_scm ());
 558     }
 559
 560   SCM pitches = Chord::to_pitches (chord);
 561   for (SCM i = pitches; gh_pair_p (i); i = gh_cdr (i))
 562     {
 563       Note_req* n = new Note_req;
 564       n->set_mus_property ("pitch", gh_car (i));
 565       n->set_mus_property ("duration", dur);
 566       l = gh_cons (n->self_scm (), l);
 567
 568       scm_unprotect_object (n->self_scm ());
 569     }
 570
 571   Simultaneous_music*v = new Request_chord (l);
 572
 573   return v;
 574 }
 575
 576