2 ;;; chord-name.scm -- Compile chord name
4 ;;; source file of the GNU LilyPond music typesetter
6 ;;; (c) 2000--2001 Jan Nieuwenhuizen <janneke@gnu.org>
18 ;; (octave notename accidental)
22 ;; text: scm markup text -- see font.scm and input/test/markup.ly
27 ;; * clean split of bass/banter/american stuff
28 ;; * text definition is rather ad-hoc
29 ;; * do without format module
30 ;; * finish and check american names
31 ;; * make notename (tonic) configurable from lilypond
32 ;; * fix append/cons stuff in inner-name-banter
36 (define chord::names-alist-banter '())
37 (set! chord::names-alist-banter
43 (((0 . 0) (2 . 0)) . #f)
45 (((0 . 0) (2 . -1)) . ("m"))
47 (((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2")))
49 (((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4")))
51 (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
53 (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
55 (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9")))
56 (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11")))
58 chord::names-alist-banter))
63 (define (accidental->textp acc pos)
66 (list (list '(music (font-relative-size . -2))
67 `(,pos ,(string-append "accidentals-" (number->string acc)))))))
69 (define (accidental->text acc) (accidental->textp acc 'rows))
70 (define (accidental->text-super acc) (accidental->textp acc 'super))
71 (define (accidental->text-sub acc) (accidental->textp acc 'sub))
74 (define (pitch->note-name pitch)
75 (cons (cadr pitch) (caddr pitch)))
77 (define (pitch->text pitch)
79 (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65)))
80 (accidental->text-super (caddr pitch))))
83 ;;; Hooks to override chord names and note names,
84 ;;; see ly/german-chords.ly
86 (define (pitch->text-banter pitch)
89 ;; We need also steps, to allow for Cc name override,
90 ;; see input/test/Cc-chords.ly
91 (define (pitch->chord-name-text-banter pitch steps)
92 (pitch->text-banter pitch))
94 (define (pitch->note-name-text-banter pitch)
95 (pitch->text-banter pitch))
97 (define (step->text pitch)
99 (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
107 (define (step->text-banter pitch)
108 (if (= (cadr pitch) 6)
117 (define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
119 (define (pitch::semitone pitch)
120 (+ (* (car pitch) 12)
121 (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7))
124 (define (pitch::transpose pitch delta)
125 (let ((simple-octave (+ (car pitch) (car delta)))
126 (simple-notename (+ (cadr pitch) (cadr delta))))
127 (let ((octave (+ simple-octave (quotient simple-notename 7)))
128 (notename (modulo simple-notename 7)))
129 (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
130 (pitch::semitone `(,octave ,notename 0)))))
131 `(,octave ,notename ,accidental)))))
133 (define (pitch::diff pitch tonic)
134 (let ((simple-octave (- (car pitch) (car tonic)))
135 (simple-notename (- (cadr pitch) (cadr tonic))))
136 (let ((octave (+ simple-octave (quotient simple-notename 7)
137 (if (< simple-notename 0) -1 0)))
138 (notename (modulo simple-notename 7)))
139 (let ((accidental (- (pitch::semitone pitch)
140 (pitch::semitone tonic)
141 (pitch::semitone `(,octave ,notename 0)))))
142 `(,octave ,notename ,accidental)))))
144 (define (pitch::note-pitch pitch)
145 (+ (* (car pitch) 7) (cadr pitch)))
148 (define (write-me n x)
157 (define (chord::text? text)
158 (not (or (not text) (empty? text) (unspecified? text))))
160 ;; recursively remove '() #f, and #<unspecified> from text
161 (define (chord::text-cleanup dirty)
163 (let ((r (car dirty)))
165 (cons (if (pair? r) (chord::text-cleanup r) r)
166 (chord::text-cleanup (cdr dirty)))
167 (chord::text-cleanup (cdr dirty))))
168 (if (chord::text? dirty)
172 (define (chord::text-append l . r)
173 (if (not (chord::text? r))
175 (if (not (chord::text? l))
179 (define (chord::step tonic pitch)
180 (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
182 ;; text: list of word
183 ;; word: string + optional list of property
184 ;; property: align, kern, font (?), size
186 (define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
188 ;; compute the relative-to-tonic pitch that goes with 'step'
189 (define (chord::step-pitch tonic step)
190 ;; urg, we only do this for thirds
191 (if (= (modulo step 2) 0)
193 (let loop ((i 1) (pitch tonic))
197 pitch `(0 2 ,(vector-ref chord::minor-major-vec
198 ;; -1 (step=1 -> vector=0) + 7 = 6
199 (modulo (+ i 6) 7)))))))))
201 ;; find the pitches that are not part of `normal' chord
202 (define (chord::additions chord-pitches)
203 (let ((tonic (car chord-pitches)))
204 ;; walk the chord steps: 1, 3, 5
205 (let loop ((step 1) (pitches chord-pitches) (additions '()))
207 (let* ((pitch (car pitches))
208 (p-step (+ (- (pitch::note-pitch pitch)
209 (pitch::note-pitch tonic))
211 ;; pitch is an addition if
213 ;; it comes before this step or
215 ;; its step is even or
216 (= (modulo p-step 2) 0)
217 ;; has same step, but different accidental or
219 (not (equal? pitch (chord::step-pitch tonic step))))
220 ;; is the last of the chord and not one of base thirds
222 (= (length pitches) 1)))
223 (loop step (cdr pitches) (cons pitch additions))
225 (loop step (cdr pitches) additions)
226 (loop (+ step 2) pitches additions))))
227 (reverse additions)))))
229 ;; find the pitches that are missing from `normal' chord
230 (define (chord::subtractions chord-pitches)
231 (let ((tonic (car chord-pitches)))
232 (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
234 (let* ((pitch (car pitches))
235 (p-step (+ (- (pitch::note-pitch pitch)
236 (pitch::note-pitch tonic))
238 ;; pitch is an subtraction if
239 ;; a step is missing or
241 (loop (+ step 2) pitches
242 (cons (chord::step-pitch tonic step) subtractions))
243 ;; there are no pitches left, but base thirds are not yet done and
245 (= (length pitches) 1))
246 ;; present pitch is not missing step
248 (loop (+ step 2) pitches subtractions)
249 (loop (+ step 2) pitches
250 (cons (chord::step-pitch tonic step) subtractions)))
252 (loop (+ step 2) (cdr pitches) subtractions)
253 (loop step (cdr pitches) subtractions)))))
254 (reverse subtractions)))))
257 (define (chord::additions->text-banter additions subtractions)
258 (if (pair? additions)
262 (cons 'super (step->text-banter (car additions)))
263 (if (or (pair? (cdr additions))
264 (pair? subtractions))
266 (chord::additions->text-banter (cdr additions) subtractions))
269 (define (chord::subtractions->text-banter subtractions)
270 (if (pair? subtractions)
275 (cons 'super (step->text-banter (car subtractions)))
276 (if (pair? (cdr subtractions))
278 (chord::subtractions->text-banter (cdr subtractions)))
282 (define (chord::bass-and-inversion->text-banter bass-and-inversion)
283 (if (and (pair? bass-and-inversion)
284 (or (car bass-and-inversion)
285 (cdr bass-and-inversion)))
286 (list "/" (if (car bass-and-inversion)
287 (pitch->note-name-text-banter
288 (car bass-and-inversion))
289 (pitch->note-name-text-banter
290 (cdr bass-and-inversion)))
295 ;; Combine tonic, exception-part of chord name,
296 ;; additions, subtractions and bass or inversion into chord name
297 (define (chord::inner-name-banter tonic exception-part additions subtractions
298 bass-and-inversion steps)
304 (pitch->chord-name-text-banter tonic steps)
306 ;; why does list->string not work, format seems only hope...
307 (if (and (string-match "super" (format "~s" exception-part))
308 (or (pair? additions)
309 (pair? subtractions)))
311 (chord::additions->text-banter additions subtractions)
312 (chord::subtractions->text-banter subtractions)
313 (chord::bass-and-inversion->text-banter bass-and-inversion)))))
315 (define (chord::name-banter tonic exception-part unmatched-steps
316 bass-and-inversion steps)
317 (let ((additions (chord::additions unmatched-steps))
318 (subtractions (chord::subtractions unmatched-steps)))
319 (chord::inner-name-banter tonic exception-part additions subtractions
320 bass-and-inversion steps)))
323 (define (c++-pitch->scm p)
325 (list (pitch-octave p) (pitch-notename p) (pitch-alteration p))
328 (define (chord::name-banter tonic exception-part unmatched-steps
329 bass-and-inversion steps)
330 (let ((additions (chord::additions unmatched-steps))
331 (subtractions (chord::subtractions unmatched-steps)))
332 (chord::inner-name-banter tonic exception-part additions subtractions
333 bass-and-inversion steps)))
335 (define (chord::restyle name style)
336 (ly-eval (string->symbol
337 (string-append (symbol->string name)
338 (symbol->string style)))))
340 ;; check exceptions-alist for biggest matching part of try-steps
341 ;; return (MATCHED-EXCEPTION . UNMATCHED-STEPS)
342 (define (chord::exceptions-lookup-helper
343 exceptions-alist try-steps unmatched-steps exception-part)
344 (if (pair? try-steps)
345 ;; FIXME: junk '(0 . 0) from exceptions lists
347 ;; FIXME: either format exceptions list as real pitches, ie,
348 ;; including octave '((0 2 -1) ..), or drop octave
349 ;; from rest of calculations,
351 (map (lambda (x) (pitch->note-name x))
352 (append '((0 0 0)) try-steps))
355 (chord::exceptions-lookup-helper
356 #f '() unmatched-steps (cdr entry))
357 (let ((r (reverse try-steps)))
358 (chord::exceptions-lookup-helper
361 (cons (car r) unmatched-steps) #f))))
362 (cons exception-part unmatched-steps)))
364 ;; return (MATCHED-EXCEPTION . BASE-CHORD-WITH-UNMATCHED-STEPS)
365 ;; BASE-CHORD-WITH-UNMATCHED-STEPS always includes (tonic 3 5)
366 (define (chord::exceptions-lookup style steps)
367 (let* ((result (chord::exceptions-lookup-helper
368 (chord::restyle 'chord::names-alist- style)
370 (exception-part (car result))
371 (unmatched-steps (cdr result))
372 (matched-steps (if (= (length unmatched-steps) 0)
374 (+ 1 (- (length steps)
375 (length unmatched-steps)))))
376 (unmatched-with-1-3-5
377 (append (do ((i matched-steps (- i 1))
378 (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
382 (list exception-part unmatched-with-1-3-5)))
385 (define (chord::name->text style tonic steps bass-and-inversion)
386 (let* ((lookup (chord::exceptions-lookup style steps))
387 (exception-part (car lookup))
388 (unmatched-steps (cadr lookup)))
389 ((chord::restyle 'chord::name- style)
390 tonic exception-part unmatched-steps bass-and-inversion steps)))
394 ;; Check for each subset of chord, full chord first, if there's a
395 ;; user-override. Split the chord into user-overridden and to-be-done
396 ;; parts, complete the missing user-override matched part with normal
397 ;; chord to be name-calculated.
399 ;; CHORD: (pitches (bass . inversion))
400 (define (default-chord-name-function style chord)
401 (let* ((pitches (map c++-pitch->scm (car chord)))
402 (modifiers (cdr chord))
403 (bass-and-inversion (if (pair? modifiers)
404 (cons (c++-pitch->scm (car modifiers))
405 (c++-pitch->scm (cdr modifiers)))
407 (diff (pitch::diff '(0 0 0) (car pitches)))
408 (steps (if (cdr pitches) (map (lambda (x)
409 (pitch::transpose x diff))
412 (chord::name->text style (car pitches) steps bass-and-inversion)))
421 ;; NOTE: Duplicates of chord names defined elsewhere occur in this list
422 ;; in order to prevent spurious superscripting of various chord names,
423 ;; such as maj7, maj9, etc.
425 ;; See input/test/american-chords.ly
427 ;; James Hammons, <jlhamm@pacificnet.net>
430 ;; DONT use non-ascii characters, even if ``it works'' in Windows
432 (define chord::names-alist-american '())
434 (set! chord::names-alist-american
438 (((0 . 0) (2 . 0)) . #f)
440 (((0 . 0) (4 . 0)) . ("5"))
442 (((0 . 0) (2 . -1)) . ("m"))
443 (((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
444 (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
445 ;Alternate: (((0 . 0) (2 . -1) (4 . -1)) . ("" (super "o")))
446 (((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
447 ;Alternate: (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
448 (((0 . 0) (1 . 0) (4 . 0)) . ("2"))
449 ;; Common seventh chords
450 (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") "7"))
451 (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
452 ;; urg! should use (0 . 0 2 . -1) -> "m", and add "7" to that!!
453 (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7"))
454 (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7"))
455 (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)"))
456 ;jazz: the delta, see jazz-chords.ly
457 ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super ((font-family . math) "N"))
458 ;; ugh, kludge slashed o
459 ;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") ((kern . -0.85) ((raise . 0.57) ((font-relative-size . -3) "/"))) "7")) ; slashed o
460 (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") (((kern . -0.85) (raise . 1.1) (font-relative-size . -2)) "/") "7")) ; slashed o
462 (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
463 (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
464 (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
465 (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4"))
466 ;; Common ninth chords
467 (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7'
468 (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6"))
469 (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6"))
470 (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9"))
471 (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9"))
472 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9"))
473 (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9"))
476 chord::names-alist-american))
479 ;; American style chordnames use no "no",
480 ;; but otherwise very similar to banter for now
481 (define (chord::name-american tonic exception-part unmatched-steps
482 bass-and-inversion steps)
483 (let ((additions (chord::additions unmatched-steps))
485 (chord::inner-name-banter tonic exception-part additions subtractions
486 bass-and-inversion steps)))
496 ;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
497 ;; NBs: This uses the american list as a bass.
498 ;; Some defs take up more than one line,
499 ;; be carefull when messing with ;'s!!
504 ;; This is getting out-of hand? Only exceptional chord names that
505 ;; cannot be generated should be here.
506 ;; Maybe we should have inner-jazz-name and inner-american-name functions;
510 ;; DONT use non-ascii characters, even if ``it works'' in Windows
512 (define chord::names-alist-jazz '())
513 (set! chord::names-alist-jazz
517 ; major sixth chord = 6
518 (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6")))
519 ; major seventh chord = triangle
520 ;; shouldn't this be a filled black triange, like this: ? --jcn
521 ;; (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . (((raise . 0.5)((font-family . math) "N"))))
522 (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . (((raise . 0.5)((font-family . math) "M"))))
523 ; major chord add nine = add9
524 (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9")))
525 ; major sixth chord with nine = 6/9
526 (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9")))
529 ; minor sixth chord = m6
530 (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6")))
531 ;; minor major seventh chord = m triangle
532 ;; shouldn't this be a filled black triange, like this: ? --jcn
533 ;;(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "N"))))
534 (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "M"))))
535 ; minor seventh chord = m7
536 (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7")))
537 ; minor sixth nine chord = m6/9
538 (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9")))
539 ; minor with added nine chord = madd9
540 (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9")))
541 ; minor ninth chord = m9
542 (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9")))
545 ; dominant seventh = 7
546 (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7")))
547 ; augmented dominant = +7
548 ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised
549 (((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised
550 ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(")
551 ; ((raise . 0.3)(music (named ("accidentals-1"))))
552 ; ((raise . 0.5) "5)"))); 7(#5)
553 ; dominant flat 5 = 7(b5)
554 (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(")
555 ((raise . 0.3)(music (named ("accidentals--1"))))
556 ((raise . 0.5) "5)")))
558 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)")))
559 ; dominant flat 9 = 7(b9)
560 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . (
562 ((raise . 0.3)(music (named ("accidentals--1"))))
563 ((raise . 0.8)"9)")))
564 ; dominant sharp 9 = 7(#9)
565 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . (
567 ((raise . 0.3)(music (named ("accidentals-1"))))
568 ((raise . 0.8)"9)")))
569 ; dominant 13 = 7(13)
570 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)")))
571 ; dominant flat 13 = 7(b13)
572 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . (
574 ((raise . 0.3)(music (named ("accidentals--1"))))
575 ((raise . 0.8)"13)")))
576 ; dominant 9, 13 = 7(9,13)
577 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9, 13)")))
578 ; dominant flat 9, 13 = 7(b9,13)
579 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . (
581 ((raise . 0.3)(music (named ("accidentals--1"))))
582 ((raise . 0.8)"9, 13)")))
583 ; dominant sharp 9, 13 = 7(#9,13)
584 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . (
586 ((raise . 0.3)(music (named ("accidentals-1"))))
587 ((raise . 0.8)"9, 13)")))
588 ; dominant 9, flat 13 = 7(9,b13)
589 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . (
590 ((raise . 0.8)"7(9, ")
591 ((raise . 0.3)(music (named ("accidentals--1"))))
592 ((raise . 0.8)"13)")))
593 ; dominant flat 9, flat 13 = 7(b9,b13)
594 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . (
596 ((raise . 0.3)(music (named ("accidentals--1"))))
598 ((raise . 0.3)(music (named ("accidentals--1"))))
599 ((raise . 0.8)"13)")))
600 ; dominant sharp 9, flat 13 = 7(#9,b13)
601 (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . (
603 ((raise . 0.3)(music (named ("accidentals-1"))))
605 ((raise . 0.3)(music (named ("accidentals--1"))))
606 ((raise . 0.8)"13)")))
608 ;; diminished chord(s)
609 ; diminished seventh chord = o
612 ;; DONT use non-ascii characters, even if ``it works'' in Windows
614 ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o")))
615 (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
617 ;; half diminshed chords
618 ;; half diminished seventh chord = slashed o
619 ;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8) "/o")))
620 (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") (((kern . -0.85) (raise . 1.1) (font-relative-size . -2)) "/") "7")) ; slashed o
622 ; half diminished seventh chord with major 9 = slashed o cancelation 9
623 (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . (
625 ((raise . 0.3)(music (named ("accidentals-0"))))
626 ((raise . 0.8)"9)")));
628 ;; Missing jazz chord definitions go here (note new syntax: see american for hints)
631 chord::names-alist-american))
633 (define (step->text-alternate-jazz pitch)
635 (accidental->text (caddr pitch))
636 (list (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8))))))
638 (define (step->text-jazz pitch)
639 (if (= (cadr pitch) 6)
641 ;; sharp 7 only included for completeness?
642 ((-2) (cons (accidental->text -1) '("7")))
645 ((1) (cons (accidental->text-super 1) '("7")))
646 ((2) (cons (accidental->text-super 2) '("7"))))
647 (step->text-alternate-jazz pitch)))
649 (define (chord::additions->text-jazz additions subtractions)
650 (if (pair? additions)
654 (cons 'super (step->text-jazz (car additions)))
655 (if (or (pair? (cdr additions))
656 (pair? subtractions))
658 (chord::additions->text-jazz (cdr additions) subtractions))
661 (define (chord::subtractions->text-jazz subtractions)
662 (if (pair? subtractions)
667 (cons 'super (step->text-jazz (car subtractions)))
668 (if (pair? (cdr subtractions))
670 (chord::subtractions->text-jazz (cdr subtractions)))
674 ;; TODO: maybe merge with inner-name-banter
675 ;; Combine tonic, exception-part of chord name,
676 ;; additions, subtractions and bass or inversion into chord name
677 (define (chord::inner-name-jazz tonic exception-part additions subtractions
678 bass-and-inversion steps)
686 (pitch->chord-name-text-banter tonic steps)
688 ;; why does list->string not work, format seems only hope...
689 (if (and (string-match "super" (format "~s" exception-part))
690 (or (pair? additions)
691 (pair? subtractions)))
693 (chord::additions->text-jazz additions subtractions)
694 (chord::subtractions->text-jazz subtractions)
695 (chord::bass-and-inversion->text-banter bass-and-inversion)))))
697 ;; Jazz style--basically similar to american with minor changes
698 (define (chord::name-jazz tonic exception-part unmatched-steps
699 bass-and-inversion steps)
700 (let ((additions (chord::additions unmatched-steps))
701 ;; get no 'omit' or 'no'
702 ;; (subtractions #f))
703 (subtractions (chord::subtractions unmatched-steps)))
704 (chord::inner-name-jazz tonic exception-part additions subtractions
705 bass-and-inversion steps)))
707 ;; wip (set! chord::names-alist-jazz
708 (define amy-chord::names-alist-jazz
711 (((0 . 0) (2 . -1)) . ("m"))
713 chord::names-alist-american))