scm/chord-name.scm

   1 ;;;
   2 ;;; chord-name.scm -- Compile chord name
   3 ;;;
   4 ;;; source file of the GNU LilyPond music typesetter
   5 ;;;
   6 ;;; (c) 2000--2001 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;
   8
   9
  10 (use-modules
  11    (ice-9 debug)
  12    (ice-9 format)
  13    (ice-9 regex)
  14    (ice-9 string-fun)
  15    )
  16
  17 ;;
  18 ;; (octave notename accidental)
  19 ;;
  20
  21 ;;
  22 ;; text: scm markup text -- see font.scm and input/test/markup.ly
  23 ;;
  24
  25 ;; TODO
  26 ;;
  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
  33 ;; * doc strings.
  34
  35 ;;;;;;;;;
  36 (define chord::names-alist-banter '())
  37 (set! chord::names-alist-banter
  38       (append
  39         '(
  40         ; C iso C.no3.no5
  41         (((0 . 0)) . #f)
  42         ; C iso C.no5
  43         (((0 . 0) (2 . 0)) . #f)
  44         ; Cm iso Cm.no5
  45         (((0 . 0) (2 . -1)) . ("m"))
  46         ; C2 iso C2.no3
  47         (((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2")))
  48         ; C4 iso C4.no3
  49         (((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4")))
  50         ;; Cdim iso Cm5-
  51         (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
  52         ; Co iso Cm5-7-
  53         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
  54         ; Cdim9
  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")))
  57         )
  58       chord::names-alist-banter))
  59
  60 ;;;;;;;;;;
  61
  62
  63 (define (accidental->text acc)
  64   (if (= acc 0)
  65       '()
  66        (list '(music (font-relative-size . -2))
  67              (string-append "accidentals-" (number->string acc)))))
  68
  69 (define (accidental->text-super acc)
  70   (if (= acc 0)
  71       '()
  72       (cons 'super (list (accidental->text acc)))))
  73
  74 (define (accidental->text-sub acc)
  75   (if (= acc 0)
  76       '()
  77       (cons sub (list accidental->text acc))))
  78
  79
  80 (define (pitch->note-name pitch)
  81   (cons (cadr pitch) (caddr pitch)))
  82
  83 (define (pitch->text pitch)
  84   (cons
  85    (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65)))
  86    (accidental->text-super (caddr pitch))))
  87
  88
  89 ;;; Hooks to override chord names and note names,
  90 ;;; see input/tricks/german-chords.ly
  91
  92 (define (pitch->text-banter pitch)
  93   (pitch->text pitch))
  94
  95 ;; We need also steps, to allow for Cc name override,
  96 ;; see input/test/Cc-chords.ly
  97 (define (pitch->chord-name-text-banter pitch steps)
  98   (pitch->text-banter pitch))
  99
 100 (define (pitch->note-name-text-banter pitch)
 101   (pitch->text-banter pitch))
 102
 103 (define (step->text pitch)
 104   (list (string-append
 105     (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
 106     (case (caddr pitch)
 107       ((-2) "--")
 108       ((-1) "-")
 109       ((0) "")
 110       ((1) "+")
 111       ((2) "++")))))
 112
 113 (define (step->text-banter pitch)
 114   (if (= (cadr pitch) 6)
 115       (case (caddr pitch)
 116         ((-2) '("7-"))
 117         ((-1) '("7"))
 118         ((0) '("maj7"))
 119         ((1) '("7+"))
 120         ((2) '("7+")))
 121       (step->text pitch)))
 122
 123 (define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
 124
 125 (define (pitch::semitone pitch)
 126   (+ (* (car pitch) 12)
 127      (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7))
 128      (caddr pitch)))
 129
 130 (define (pitch::transpose pitch delta)
 131   (let ((simple-octave (+ (car pitch) (car delta)))
 132         (simple-notename (+ (cadr pitch) (cadr delta))))
 133     (let ((octave (+ simple-octave (quotient simple-notename 7)))
 134            (notename (modulo simple-notename 7)))
 135       (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
 136                            (pitch::semitone `(,octave ,notename 0)))))
 137         `(,octave ,notename ,accidental)))))
 138
 139 (define (pitch::diff pitch tonic)
 140   (let ((simple-octave (- (car pitch) (car tonic)))
 141         (simple-notename (- (cadr pitch) (cadr tonic))))
 142     (let ((octave (+ simple-octave (quotient simple-notename 7)
 143                      (if (< simple-notename 0) -1 0)))
 144           (notename (modulo simple-notename 7)))
 145       (let ((accidental (- (pitch::semitone pitch)
 146                           (pitch::semitone tonic)
 147                           (pitch::semitone `(,octave ,notename 0)))))
 148         `(,octave ,notename ,accidental)))))
 149
 150 (define (pitch::note-pitch pitch)
 151   (+ (* (car pitch) 7) (cadr pitch)))
 152
 153
 154 (define (write-me n x)
 155   (display n)
 156   (write x)
 157   (newline)
 158   x)
 159
 160 (define (empty? x)
 161   (equal? x '()))
 162
 163 (define (chord::text? text)
 164   (not (or (not text) (empty? text) (unspecified? text))))
 165
 166 ;; recursively remove '() #f, and #<unspecified> from text
 167 (define (chord::text-cleanup dirty)
 168   (if (pair? dirty)
 169       (let ((r (car dirty)))
 170         (if (chord::text? r)
 171             (cons (if (pair? r) (chord::text-cleanup r) r)
 172                   (chord::text-cleanup (cdr dirty)))
 173             (chord::text-cleanup (cdr dirty))))
 174       (if (chord::text? dirty)
 175           dirty
 176           '())))
 177
 178 (define (chord::text-append l . r)
 179   (if (not (chord::text? r))
 180       l
 181       (if (not (chord::text? l))
 182           r
 183           (cons l r))))
 184
 185 (define (chord::step tonic pitch)
 186  (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
 187
 188 ;; text: list of word
 189 ;; word: string + optional list of property
 190 ;; property: align, kern, font (?), size
 191
 192 (define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
 193
 194 ;; compute the relative-to-tonic pitch that goes with 'step'
 195 (define (chord::step-pitch tonic step)
 196   ;; urg, we only do this for thirds
 197   (if (= (modulo step 2) 0)
 198     '(0 0 0)
 199     (let loop ((i 1) (pitch tonic))
 200       (if (= i step) pitch
 201         (loop (+ i 2)
 202               (pitch::transpose
 203                 pitch `(0 2 ,(vector-ref chord::minor-major-vec
 204                 ;; -1 (step=1 -> vector=0) + 7 = 6
 205                 (modulo (+ i 6) 7)))))))))
 206
 207 ;; find the pitches that are not part of `normal' chord
 208 (define (chord::additions chord-pitches)
 209   (let ((tonic (car chord-pitches)))
 210     ;; walk the chord steps: 1, 3, 5
 211     (let loop ((step 1) (pitches chord-pitches) (additions '()))
 212       (if (pair? pitches)
 213         (let* ((pitch (car pitches))
 214                (p-step (+ (- (pitch::note-pitch pitch)
 215                              (pitch::note-pitch tonic))
 216                           1)))
 217           ;; pitch is an addition if
 218           (if (or
 219                 ;; it comes before this step or
 220                 (< p-step step)
 221                 ;; its step is even or
 222                 (= (modulo p-step 2) 0)
 223                 ;; has same step, but different accidental or
 224                 (and (= p-step step)
 225                      (not (equal? pitch (chord::step-pitch tonic step))))
 226                 ;; is the last of the chord and not one of base thirds
 227                 (and (> p-step  5)
 228                      (= (length pitches) 1)))
 229             (loop step (cdr pitches) (cons pitch additions))
 230           (if (= p-step step)
 231             (loop step (cdr pitches) additions)
 232             (loop (+ step 2) pitches additions))))
 233       (reverse additions)))))
 234
 235 ;; find the pitches that are missing from `normal' chord
 236 (define (chord::subtractions chord-pitches)
 237   (let ((tonic (car chord-pitches)))
 238     (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
 239       (if (pair? pitches)
 240         (let* ((pitch (car pitches))
 241                (p-step (+ (- (pitch::note-pitch pitch)
 242                              (pitch::note-pitch tonic))
 243                           1)))
 244           ;; pitch is an subtraction if
 245           ;; a step is missing or
 246           (if (> p-step step)
 247             (loop (+ step 2) pitches
 248                 (cons (chord::step-pitch tonic step) subtractions))
 249           ;; there are no pitches left, but base thirds are not yet done and
 250           (if (and (<= step 5)
 251                    (= (length pitches) 1))
 252             ;; present pitch is not missing step
 253             (if (= p-step step)
 254               (loop (+ step 2) pitches subtractions)
 255               (loop (+ step 2) pitches
 256                     (cons (chord::step-pitch tonic step) subtractions)))
 257             (if (= p-step step)
 258               (loop (+ step 2) (cdr pitches) subtractions)
 259               (loop step (cdr pitches) subtractions)))))
 260         (reverse subtractions)))))
 261
 262
 263 (define (chord::additions->text-banter additions subtractions)
 264   (if (pair? additions)
 265       (cons (apply append
 266                    (chord::text-cleanup
 267                     (list
 268                      (cons 'super (step->text-banter (car additions)))
 269                      (if (or (pair? (cdr additions))
 270                              (pair? subtractions))
 271                          '(super "/")))))
 272             (chord::additions->text-banter (cdr additions) subtractions))
 273       '()))
 274
 275 (define (chord::subtractions->text-banter subtractions)
 276   (if (pair? subtractions)
 277       (cons (apply append
 278                    (chord::text-cleanup
 279                     (list
 280                      '(super "no")
 281                      (cons 'super (step->text-banter (car subtractions)))
 282                      (if (pair? (cdr subtractions))
 283                          '(super "/")))))
 284             (chord::subtractions->text-banter (cdr subtractions)))
 285         '()))
 286
 287
 288 (define (chord::bass-and-inversion->text-banter bass-and-inversion)
 289   (if (and (pair? bass-and-inversion)
 290            (or (car bass-and-inversion)
 291                (cdr bass-and-inversion)))
 292       (list "/" (if (car bass-and-inversion)
 293                     (pitch->note-name-text-banter
 294                      (car bass-and-inversion))
 295                     (pitch->note-name-text-banter
 296                      (cdr bass-and-inversion)))
 297             '())
 298       '()))
 299
 300 ;; Banter style
 301 ;; Combine tonic, exception-part of chord name,
 302 ;; additions, subtractions and bass or inversion into chord name
 303 (define (chord::inner-name-banter tonic exception-part additions subtractions
 304                                   bass-and-inversion steps)
 305   ;; ugh
 306   (apply
 307    append
 308    (chord::text-cleanup
 309     (list '(rows)
 310           (pitch->chord-name-text-banter tonic steps)
 311           exception-part
 312           ;; why does list->string not work, format seems only hope...
 313           (if (and (string-match "super" (format "~s" exception-part))
 314                    (or (pair? additions)
 315                        (pair? subtractions)))
 316               '((super "/")))
 317          (chord::additions->text-banter additions subtractions)
 318          (chord::subtractions->text-banter subtractions)
 319          (chord::bass-and-inversion->text-banter bass-and-inversion)))))
 320
 321 (define (chord::name-banter tonic exception-part unmatched-steps
 322                             bass-and-inversion steps)
 323   (let ((additions (chord::additions unmatched-steps))
 324         (subtractions (chord::subtractions unmatched-steps)))
 325     (chord::inner-name-banter tonic exception-part additions subtractions
 326                               bass-and-inversion steps)))
 327
 328
 329 (define (c++-pitch->scm p)
 330   (if (pitch? p)
 331       (list (pitch-octave p) (pitch-notename p) (pitch-alteration p))
 332       #f))
 333
 334 (define (chord::name-banter tonic exception-part unmatched-steps
 335                             bass-and-inversion steps)
 336   (let ((additions (chord::additions unmatched-steps))
 337         (subtractions (chord::subtractions unmatched-steps)))
 338     (chord::inner-name-banter tonic exception-part additions subtractions
 339                               bass-and-inversion steps)))
 340
 341 (define (chord::restyle name style)
 342   (ly-eval (string->symbol
 343             (string-append (symbol->string name)
 344                            (symbol->string style)))))
 345
 346 ;; check exceptions-alist for biggest matching part of try-steps
 347 ;; return (MATCHED-EXCEPTION . UNMATCHED-STEPS)
 348 (define (chord::exceptions-lookup-helper
 349          exceptions-alist try-steps unmatched-steps exception-part)
 350   (if (pair? try-steps)
 351       ;; FIXME: junk '(0 . 0) from exceptions lists
 352       ;;
 353       ;; FIXME: either format exceptions list as real pitches, ie,
 354       ;;        including octave '((0 2 -1) ..), or drop octave
 355       ;;        from rest of calculations,
 356       (let ((entry (assoc
 357                     (map (lambda (x) (pitch->note-name x))
 358                          (append '((0 0 0)) try-steps))
 359                     exceptions-alist)))
 360         (if entry
 361             (chord::exceptions-lookup-helper
 362              #f '() unmatched-steps (cdr entry))
 363             (let ((r (reverse try-steps)))
 364               (chord::exceptions-lookup-helper
 365                exceptions-alist
 366                (reverse (cdr r))
 367                (cons (car r) unmatched-steps) #f))))
 368       (cons exception-part unmatched-steps)))
 369
 370 ;; return (MATCHED-EXCEPTION . BASE-CHORD-WITH-UNMATCHED-STEPS)
 371 ;; BASE-CHORD-WITH-UNMATCHED-STEPS always includes (tonic 3 5)
 372 (define (chord::exceptions-lookup style steps)
 373   (let* ((result (chord::exceptions-lookup-helper
 374                   (chord::restyle 'chord::names-alist- style)
 375                   steps '() #f))
 376            (exception-part (car result))
 377            (unmatched-steps (cdr result))
 378            (matched-steps (if (= (length unmatched-steps) 0)
 379                               3
 380                               (+ 1 (- (length steps)
 381                                       (length unmatched-steps)))))
 382            (unmatched-with-1-3-5
 383             (append (do ((i matched-steps (- i 1))
 384                          (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
 385                         ((= i 0) base)
 386                       ())
 387                     unmatched-steps)))
 388     (list exception-part unmatched-with-1-3-5)))
 389
 390
 391 (define (chord::name->text style tonic steps bass-and-inversion)
 392   (let* ((lookup (chord::exceptions-lookup style steps))
 393          (exception-part (car lookup))
 394          (unmatched-steps (cadr lookup)))
 395     ((chord::restyle 'chord::name- style)
 396      tonic exception-part unmatched-steps bass-and-inversion steps)))
 397
 398 ;; C++ entry point
 399 ;;
 400 ;; Check for each subset of chord, full chord first, if there's a
 401 ;; user-override.  Split the chord into user-overridden and to-be-done
 402 ;; parts, complete the missing user-override matched part with normal
 403 ;; chord to be name-calculated.
 404 ;;
 405 ;; CHORD: (pitches (bass . inversion))
 406 (define (default-chord-name-function style chord)
 407   (let* ((pitches (map c++-pitch->scm (car chord)))
 408          (modifiers (cdr chord))
 409          (bass-and-inversion (if (pair? modifiers)
 410                                  (cons (c++-pitch->scm (car modifiers))
 411                                        (c++-pitch->scm (cdr modifiers)))
 412                                  '(() . ())))
 413          (diff (pitch::diff '(0 0 0) (car pitches)))
 414          (steps (if (cdr pitches) (map (lambda (x)
 415                                          (pitch::transpose x diff))
 416                                        (cdr pitches))
 417                     '())))
 418     (chord::name->text style (car pitches) steps bass-and-inversion)))
 419
 420
 421
 422 ;;;
 423 ;;; American style
 424 ;;;
 425
 426
 427 ;; NOTE: Duplicates of chord names defined elsewhere occur in this list
 428 ;; in order to prevent spurious superscripting of various chord names,
 429 ;; such as maj7, maj9, etc.
 430 ;;
 431 ;; See input/test/american-chords.ly
 432 ;;
 433 ;; James Hammons, <jlhamm@pacificnet.net>
 434 ;;
 435
 436 ;; DONT use non-ascii characters, even if ``it works'' in Windows
 437
 438 (define chord::names-alist-american '())
 439
 440 (set! chord::names-alist-american
 441       (append
 442        '(
 443          (((0 . 0)) . #f)
 444          (((0 . 0) (2 . 0)) . #f)
 445          ;; Root-fifth chord
 446          (((0 . 0) (4 . 0)) . ("5"))
 447          ;; Common triads
 448          (((0 . 0) (2 . -1)) . ("m"))
 449          (((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
 450          (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
 451 ;Alternate:      (((0 . 0) (2 . -1) (4 . -1)) . ("" (super "o")))
 452          (((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
 453 ;Alternate:      (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
 454          (((0 . 0) (1 . 0) (4 . 0)) . ("2"))
 455          ;; Common seventh chords
 456          (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") "7"))
 457          (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
 458          ;; urg! should use (0 . 0 2 . -1) -> "m", and add "7" to that!!
 459          (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7"))
 460          (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7"))
 461          (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)"))
 462          ;jazz: the delta, see jazz-chords.ly
 463          ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .  (super ((font-family . math) "N"))
 464          ;; ugh, kludge slashed o
 465          ;; (((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
 466          (((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
 467
 468          (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
 469          (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
 470          (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
 471          (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4"))
 472          ;; Common ninth chords
 473          (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7'
 474          (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6"))
 475          (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6"))
 476          (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9"))
 477          (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9"))
 478          (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9"))
 479          (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9"))
 480
 481          )
 482       chord::names-alist-american))
 483
 484
 485 ;; American style chordnames use no "no",
 486 ;; but otherwise very similar to banter for now
 487 (define (chord::name-american tonic exception-part unmatched-steps
 488                               bass-and-inversion steps)
 489   (let ((additions (chord::additions unmatched-steps))
 490         (subtractions #f))
 491     (chord::inner-name-banter tonic exception-part additions subtractions
 492                               bass-and-inversion steps)))
 493
 494
 495
 496 ;;;
 497 ;;; Jazz style
 498 ;;;
 499
 500
 501
 502 ;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
 503 ;; NBs: This uses the american list as a bass.
 504 ;;      Some defs take up more than one line,
 505 ;; be carefull when messing with ;'s!!
 506
 507
 508 ;; FIXME
 509 ;;
 510 ;; This is getting out-of hand?  Only exceptional chord names that
 511 ;; cannot be generated should be here.
 512 ;; Maybe we should have inner-jazz-name and inner-american-name functions;
 513 ;;
 514 ;;
 515 ;;
 516 ;; DONT use non-ascii characters, even if ``it works'' in Windows
 517
 518 (define chord::names-alist-jazz '())
 519 (set! chord::names-alist-jazz
 520       (append
 521       '(
 522         ;; major chords
 523         ; major sixth chord = 6
 524         (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6")))
 525         ; major seventh chord = triangle
 526         ;; shouldn't this be a filled black triange, like this:  ? --jcn
 527         ;; (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "N"))))
 528         (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "M"))))
 529         ; major chord add nine = add9
 530         (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9")))
 531         ; major sixth chord with nine = 6/9
 532         (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9")))
 533
 534         ;; minor chords
 535         ; minor sixth chord = m6
 536         (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6")))
 537         ;; minor major seventh chord = m triangle
 538         ;; shouldn't this be a filled black triange, like this:  ? --jcn
 539         ;;(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "N"))))
 540         (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . math) "M"))))
 541         ; minor seventh chord = m7
 542         (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7")))
 543         ; minor sixth nine chord = m6/9
 544         (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9")))
 545         ; minor with added nine chord = madd9
 546         (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9")))
 547         ; minor ninth chord = m9
 548         (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9")))
 549
 550         ;; dominant chords
 551         ; dominant seventh = 7
 552         (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7")))
 553         ; augmented dominant = +7
 554         ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised
 555         (((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised
 556         ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(")
 557         ;       ((raise . 0.3)(music (named ("accidentals-1"))))
 558         ;       ((raise . 0.5) "5)"))); 7(#5)
 559         ; dominant flat 5 = 7(b5)
 560         (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(")
 561                 ((raise . 0.3)(music (named ("accidentals--1"))))
 562                 ((raise . 0.5) "5)")))
 563         ; dominant 9 = 7(9)
 564         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)")))
 565         ; dominant flat 9 = 7(b9)
 566         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . (
 567                 ((raise . 0.8)"7(")
 568                 ((raise . 0.3)(music (named ("accidentals--1"))))
 569                 ((raise . 0.8)"9)")))
 570         ; dominant sharp 9 = 7(#9)
 571         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . (
 572                 ((raise . 0.8)"7(")
 573                 ((raise . 0.3)(music (named ("accidentals-1"))))
 574                 ((raise . 0.8)"9)")))
 575         ; dominant 13 = 7(13)
 576         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)")))
 577         ; dominant flat 13 = 7(b13)
 578         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . (
 579                 ((raise . 0.8)"7(")
 580                 ((raise . 0.3)(music (named ("accidentals--1"))))
 581                 ((raise . 0.8)"13)")))
 582         ; dominant 9, 13 = 7(9,13)
 583         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9, 13)")))
 584         ; dominant flat 9, 13 = 7(b9,13)
 585         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . (
 586                 ((raise . 0.8)"7(")
 587                 ((raise . 0.3)(music (named ("accidentals--1"))))
 588                 ((raise . 0.8)"9, 13)")))
 589         ; dominant sharp 9, 13 = 7(#9,13)
 590         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . (
 591                 ((raise . 0.8)"7(")
 592                 ((raise . 0.3)(music (named ("accidentals-1"))))
 593                 ((raise . 0.8)"9, 13)")))
 594         ; dominant 9, flat 13 = 7(9,b13)
 595         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . (
 596                 ((raise . 0.8)"7(9, ")
 597                 ((raise . 0.3)(music (named ("accidentals--1"))))
 598                 ((raise . 0.8)"13)")))
 599         ; dominant flat 9, flat 13 = 7(b9,b13)
 600         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . (
 601                 ((raise . 0.8)"7(")
 602                 ((raise . 0.3)(music (named ("accidentals--1"))))
 603                 ((raise . 0.8)"9, ")
 604                 ((raise . 0.3)(music (named ("accidentals--1"))))
 605                 ((raise . 0.8)"13)")))
 606         ; dominant sharp 9, flat 13 = 7(#9,b13)
 607         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . (
 608                 ((raise . 0.8)"7(")
 609                 ((raise . 0.3)(music (named ("accidentals-1"))))
 610                 ((raise . 0.8)"9, ")
 611                 ((raise . 0.3)(music (named ("accidentals--1"))))
 612                 ((raise . 0.8)"13)")))
 613
 614         ;; diminished chord(s)
 615         ; diminished seventh chord =  o
 616
 617
 618         ;; DONT use non-ascii characters, even if ``it works'' in Windows
 619
 620         ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o")))
 621         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
 622
 623         ;; half diminshed chords
 624         ;; half diminished seventh chord = slashed o
 625         ;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8) "/o")))
 626         (((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
 627
 628         ; half diminished seventh chord  with major 9 = slashed o cancelation 9
 629         (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . (
 630                 ((raise . 0.8)"/o(")
 631                 ((raise . 0.3)(music (named ("accidentals-0"))))
 632                 ((raise . 0.8)"9)")));
 633
 634 ;; Missing jazz chord definitions go here (note new syntax: see american for hints)
 635
 636         )
 637       chord::names-alist-american))
 638
 639 (define (step->text-alternate-jazz pitch)
 640   (cons
 641    (accidental->text (caddr pitch))
 642    (list (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8))))))
 643
 644 (define (step->text-jazz pitch)
 645   (if (= (cadr pitch) 6)
 646       (case (caddr pitch)
 647         ;; sharp 7 only included for completeness?
 648         ((-2) (cons (accidental->text -1) '("7")))
 649         ((-1) '("7"))
 650         ((0) '("maj7"))
 651         ((1) (cons (accidental->text-super 1) '("7")))
 652         ((2) (cons (accidental->text-super 2) '("7"))))
 653       (step->text-alternate-jazz pitch)))
 654
 655 (define (chord::additions->text-jazz additions subtractions)
 656   (if (pair? additions)
 657       (cons (apply append
 658                    (chord::text-cleanup
 659                     (list
 660                      (cons 'super (step->text-jazz (car additions)))
 661                      (if (or (pair? (cdr additions))
 662                              (pair? subtractions))
 663                          '(super "/")))))
 664             (chord::additions->text-jazz (cdr additions) subtractions))
 665       '()))
 666
 667 (define (chord::subtractions->text-jazz subtractions)
 668   (if (pair? subtractions)
 669       (cons (apply append
 670                    (chord::text-cleanup
 671                     (list
 672                      '(super "omit")
 673                      (cons 'super (step->text-jazz (car subtractions)))
 674                      (if (pair? (cdr subtractions))
 675                          '(super "/")))))
 676             (chord::subtractions->text-jazz (cdr subtractions)))
 677         '()))
 678
 679
 680 ;; TODO: maybe merge with inner-name-banter
 681 ;; Combine tonic, exception-part of chord name,
 682 ;; additions, subtractions and bass or inversion into chord name
 683 (define (chord::inner-name-jazz tonic exception-part additions subtractions
 684                                   bass-and-inversion steps)
 685
 686   ;; ugh
 687   (apply
 688    append
 689
 690    (chord::text-cleanup
 691     (list '(rows)
 692           (pitch->chord-name-text-banter tonic steps)
 693           exception-part
 694           ;; why does list->string not work, format seems only hope...
 695           (if (and (string-match "super" (format "~s" exception-part))
 696                    (or (pair? additions)
 697                        (pair? subtractions)))
 698               '((super "/")))
 699           (chord::additions->text-jazz additions subtractions)
 700           (chord::subtractions->text-jazz subtractions)
 701           (chord::bass-and-inversion->text-banter bass-and-inversion)))))
 702
 703 ;; Jazz style--basically similar to american with minor changes
 704 (define (chord::name-jazz tonic exception-part unmatched-steps
 705                           bass-and-inversion steps)
 706   (let ((additions (chord::additions unmatched-steps))
 707         ;; get no 'omit' or 'no'
 708         ;; (subtractions #f))
 709         (subtractions (chord::subtractions unmatched-steps)))
 710     (chord::inner-name-jazz tonic exception-part additions subtractions
 711              bass-and-inversion steps)))
 712
 713 ;; wip (set! chord::names-alist-jazz
 714 (define amy-chord::names-alist-jazz
 715       (append
 716       '(
 717         (((0 . 0) (2 . -1)) . ("m"))
 718         )
 719       chord::names-alist-american))