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