scm/chord-names.scm

   1 ;;; chord.scm -- to be included in/to replace chord-name.scm
   2 ;;; 2000 janneke@gnu.org
   3 ;;;
   4
   5 (use-modules
   6    (ice-9 debug)
   7    ;; urg, these two only to guess if a '/' is needed to separate
   8    ;; user-chord-name and additions/subtractions
   9    (ice-9 format)
  10    (ice-9 regex)
  11    )
  12
  13 ;;
  14 ;; (octave notename accidental)
  15 ;;
  16
  17 ;;
  18 ;; text: scm markup text -- see font.scm and input/test/markup.ly
  19 ;;
  20
  21 ;; TODO
  22 ;;
  23 ;; * clean split of base/banter/american stuff
  24 ;; * text definition is rather ad-hoc
  25 ;; * do without format module
  26 ;; * finish and check american names
  27 ;; * make notename (tonic) configurable from mudela
  28 ;; * fix append/cons stuff in inner-name-banter
  29 ;;
  30
  31
  32 ;;;;;;;;;
  33 (define chord::names-alist-banter '())
  34 (set! chord::names-alist-banter
  35       (append
  36         '(
  37         ; C iso C.no3.no5
  38         (((0 . 0)) . #f)
  39         ; C iso C.no5
  40         (((0 . 0) (2 . 0)) . #f)
  41         ; Cm iso Cm.no5
  42         (((0 . 0) (2 . -1)) . ("m"))
  43         ; C2 iso C2.no3
  44         (((0 . 0) (1 . 0) (4 . 0)) . (super "2"))
  45         ; C4 iso C4.no3
  46         (((0 . 0) (3 . 0) (4 . 0)) . (super "4"))
  47         ; Cdim iso Cm5-
  48         (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
  49         ; Co iso Cm5-7-
  50         ; urg
  51         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super "o"))
  52         ; Cdim9
  53         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9")))
  54         (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11")))
  55         )
  56       chord::names-alist-banter))
  57
  58
  59 ;; NOTE: Duplicates of chord names defined elsewhere occur in this list
  60 ;; in order to prevent spurious superscripting of various chord names,
  61 ;; such as maj7, maj9, etc.
  62 ;;
  63 ;; See input/test/american-chords.ly
  64 ;;
  65 ;; James Hammons, <jlhamm@pacificnet.net>
  66 ;;
  67
  68 ;; DONT use non-ascii characters, even if ``it works'' in Windows
  69
  70 (define chord::names-alist-american '())
  71 (set! chord::names-alist-american
  72       (append
  73        '(
  74          (((0 . 0)) . #f)
  75          (((0 . 0) (2 . 0)) . #f)
  76          ;; Root-fifth chord
  77          (((0 . 0) (4 . 0)) . ("5"))
  78          ;; Common triads
  79          (((0 . 0) (2 . -1)) . ("m"))
  80          (((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
  81          (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
  82 ;Alternate:      (((0 . 0) (2 . -1) (4 . -1)) . ((super "o")))
  83          (((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
  84 ;Alternate:      (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
  85          (((0 . 0) (1 . 0) (4 . 0)) . ("2"))
  86          ;; Common seventh chords
  87          (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (rows (super "o") "7"))
  88          (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
  89          (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7"))
  90          (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7"))
  91          (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)"))
  92          ;jazz: the delta, see jazz-chords.ly
  93          ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .  (super ((font-family . math) "N"))
  94          ;; slashed o
  95          (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") ((raise . 0.5) ((kern . -0.5) ((font-relative-size . -3) "/"))) "7")) ; slashed o
  96          (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
  97          (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
  98          (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
  99          (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4"))
 100          ;; Common ninth chords
 101          (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the '/no7'
 102          (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6"))
 103          (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6"))
 104          (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9"))
 105          (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9"))
 106          (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9"))
 107          (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9"))
 108
 109          )
 110       chord::names-alist-american))
 111
 112 ;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
 113 ;; NBs: This uses the american list as a base.
 114 ;;      Some defs take up more than one line,
 115 ;; be carefull when messing with ;'s!!
 116
 117
 118 ;; FIXME
 119 ;;
 120 ;; This is getting out-of hand?  Only exceptional chord names that
 121 ;; cannot be generated should be here.
 122 ;; Maybe we should have inner-jazz-name and inner-american-name functions;
 123 ;;
 124 ;;
 125 ;;
 126 ;; DONT use non-ascii characters, even if ``it works'' in Windows
 127
 128 (define chord::names-alist-jazz '())
 129 (set! chord::names-alist-jazz
 130       (append
 131       '(
 132         ;; major chords
 133         ; major sixth chord = 6
 134         (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6")))
 135         ; major seventh chord = triangle
 136         (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . "math") "M"))))
 137         ; major chord add nine = add9
 138         (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9")))
 139         ; major sixth chord with nine = 6/9
 140         (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9")))
 141
 142         ;; minor chords
 143         ; minor sixth chord = m6
 144         (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6")))
 145         ; minor major seventh chord = m triangle
 146         (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family . "math") "M"))))
 147         ; minor seventh chord = m7
 148         (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7")))
 149         ; minor sixth nine chord = m6/9
 150         (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "6/9")))
 151         ; minor with added nine chord = madd9
 152         (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9")))
 153         ; minor ninth chord = m9
 154         (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9")))
 155
 156         ;; dominant chords
 157         ; dominant seventh = 7
 158         (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7")))
 159         ; augmented dominant = +7
 160         ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both raised
 161         (((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7 with 7 raised
 162         ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(")
 163         ;       ((raise . 0.3)(music (named ("accidentals-1"))))
 164         ;       ((raise . 0.5) "5)"))); 7(#5)
 165         ; dominant flat 5 = 7(b5)
 166         (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(")
 167                 ((raise . 0.3)(music (named ("accidentals--1"))))
 168                 ((raise . 0.5) "5)")))
 169         ; dominant 9 = 7(9)
 170         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)")))
 171         ; dominant flat 9 = 7(b9)
 172         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . (
 173                 ((raise . 0.8)"7(")
 174                 ((raise . 0.3)(music (named ("accidentals--1"))))
 175                 ((raise . 0.8)"9)")))
 176         ; dominant sharp 9 = 7(#9)
 177         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . (
 178                 ((raise . 0.8)"7(")
 179                 ((raise . 0.3)(music (named ("accidentals-1"))))
 180                 ((raise . 0.8)"9)")))
 181         ; dominant 13 = 7(13)
 182         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)")))
 183         ; dominant flat 13 = 7(b13)
 184         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . (
 185                 ((raise . 0.8)"7(")
 186                 ((raise . 0.3)(music (named ("accidentals--1"))))
 187                 ((raise . 0.8)"13)")))
 188         ; dominant 9, 13 = 7(9,13)
 189         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9, 13)")))
 190         ; dominant flat 9, 13 = 7(b9,13)
 191         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . (
 192                 ((raise . 0.8)"7(")
 193                 ((raise . 0.3)(music (named ("accidentals--1"))))
 194                 ((raise . 0.8)"9, 13)")))
 195         ; dominant sharp 9, 13 = 7(#9,13)
 196         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . (
 197                 ((raise . 0.8)"7(")
 198                 ((raise . 0.3)(music (named ("accidentals-1"))))
 199                 ((raise . 0.8)"9, 13)")))
 200         ; dominant 9, flat 13 = 7(9,b13)
 201         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . (
 202                 ((raise . 0.8)"7(9, ")
 203                 ((raise . 0.3)(music (named ("accidentals--1"))))
 204                 ((raise . 0.8)"13)")))
 205         ; dominant flat 9, flat 13 = 7(b9,b13)
 206         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . (
 207                 ((raise . 0.8)"7(")
 208                 ((raise . 0.3)(music (named ("accidentals--1"))))
 209                 ((raise . 0.8)"9, ")
 210                 ((raise . 0.3)(music (named ("accidentals--1"))))
 211                 ((raise . 0.8)"13)")))
 212         ; dominant sharp 9, flat 13 = 7(#9,b13)
 213         (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . (
 214                 ((raise . 0.8)"7(")
 215                 ((raise . 0.3)(music (named ("accidentals-1"))))
 216                 ((raise . 0.8)"9, ")
 217                 ((raise . 0.3)(music (named ("accidentals--1"))))
 218                 ((raise . 0.8)"13)")))
 219
 220         ;; diminished chord(s)
 221         ; diminished seventh chord =  o
 222
 223
 224         ;; DONT use non-ascii characters, even if ``it works'' in Windows
 225
 226         ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (((raise . 0.8)"o"))); works, but "o" is a little big
 227         (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o")))
 228
 229         ;; half diminshed chords
 230         ; half diminished seventh chord = slashed o
 231         (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8)"/o")))
 232         ; half diminished seventh chord  with major 9 = slashed o cancelation 9
 233         (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . (
 234                 ((raise . 0.8)"/o(")
 235                 ((raise . 0.3)(music (named ("accidentals-0"))))
 236                 ((raise . 0.8)"9)")));
 237
 238 ;; Missing jazz chord definitions go here (note new syntax: see american for hints)
 239
 240         )
 241       chord::names-alist-american))
 242
 243 ;;;;;;;;;;
 244
 245
 246 (define (pitch->note-name pitch)
 247   (cons (cadr pitch) (caddr pitch)))
 248
 249 (define (pitch->text pitch)
 250   (cons
 251     (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65)))
 252     (if (= (caddr pitch) 0)
 253       '()
 254       (list
 255        (append '(music)
 256                (list
 257                 (append '(named)
 258                         (list
 259                           (append '((font-relative-size . -2))
 260                                 (list (append '((raise . 0.6))
 261                                   (list
 262                                    (string-append "accidentals-"
 263                                                   (number->string (caddr pitch)))))))))))))))
 264
 265 (define (step->text pitch)
 266   (string-append
 267     (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
 268     (case (caddr pitch)
 269       ((-2) "--")
 270       ((-1) "-")
 271       ((0) "")
 272       ((1) "+")
 273       ((2) "++"))))
 274
 275 (define (pitch->text-banter pitch)
 276   (pitch->text pitch))
 277
 278 (define (step->text-banter pitch)
 279   (if (= (cadr pitch) 6)
 280       (case (caddr pitch)
 281         ((-2) "7-")
 282         ((-1) "7")
 283         ((0) "maj7")
 284         ((1) "7+")
 285         ((2) "7+"))
 286       (step->text pitch)))
 287
 288 (define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
 289
 290 (define (pitch::semitone pitch)
 291   (+ (* (car pitch) 12)
 292      (vector-ref pitch::semitone-vec (modulo (cadr pitch) 7))
 293      (caddr pitch)))
 294
 295 (define (pitch::transpose pitch delta)
 296   (let ((simple-octave (+ (car pitch) (car delta)))
 297         (simple-notename (+ (cadr pitch) (cadr delta))))
 298     (let ((octave (+ simple-octave (quotient simple-notename 7)))
 299            (notename (modulo simple-notename 7)))
 300       (let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
 301                            (pitch::semitone `(,octave ,notename 0)))))
 302         `(,octave ,notename ,accidental)))))
 303
 304 (define (pitch::diff pitch tonic)
 305   (let ((simple-octave (- (car pitch) (car tonic)))
 306         (simple-notename (- (cadr pitch) (cadr tonic))))
 307     (let ((octave (+ simple-octave (quotient simple-notename 7)
 308                      (if (< simple-notename 0) -1 0)))
 309           (notename (modulo simple-notename 7)))
 310       (let ((accidental (- (pitch::semitone pitch)
 311                           (pitch::semitone tonic)
 312                           (pitch::semitone `(,octave ,notename 0)))))
 313         `(,octave ,notename ,accidental)))))
 314
 315 (define (pitch::note-pitch pitch)
 316   (+ (* (car pitch) 7) (cadr pitch)))
 317
 318 (define (chord::step tonic pitch)
 319  (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
 320
 321 ;; text: list of word
 322 ;; word: string + optional list of property
 323 ;; property: align, kern, font (?), size
 324
 325 (define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
 326
 327 ;; compute the relative-to-tonic pitch that goes with 'step'
 328 (define (chord::step-pitch tonic step)
 329   ;; urg, we only do this for thirds
 330   (if (= (modulo step 2) 0)
 331     '(0 0 0)
 332     (let loop ((i 1) (pitch tonic))
 333       (if (= i step) pitch
 334         (loop (+ i 2)
 335               (pitch::transpose
 336                 pitch `(0 2 ,(vector-ref chord::minor-major-vec
 337                 ;; -1 (step=1 -> vector=0) + 7 = 6
 338                 (modulo (+ i 6) 7)))))))))
 339
 340 ;; find the pitches that are not part of `normal' chord
 341 (define (chord::additions chord-pitches)
 342   (let ((tonic (car chord-pitches)))
 343     ;; walk the chord steps: 1, 3, 5
 344     (let loop ((step 1) (pitches chord-pitches) (additions '()))
 345       (if (pair? pitches)
 346         (let* ((pitch (car pitches))
 347                (p-step (+ (- (pitch::note-pitch pitch)
 348                              (pitch::note-pitch tonic))
 349                           1)))
 350           ;; pitch is an addition if
 351           (if (or
 352                 ;; it comes before this step or
 353                 (< p-step step)
 354                 ;; its step is even or
 355                 (= (modulo p-step 2) 0)
 356                 ;; has same step, but different accidental or
 357                 (and (= p-step step)
 358                      (not (equal? pitch (chord::step-pitch tonic step))))
 359                 ;; is the last of the chord and not one of base thirds
 360                 (and (> p-step  5)
 361                      (= (length pitches) 1)))
 362             (loop step (cdr pitches) (cons pitch additions))
 363           (if (= p-step step)
 364             (loop step (cdr pitches) additions)
 365             (loop (+ step 2) pitches additions))))
 366       (reverse additions)))))
 367
 368 ;; find the pitches that are missing from `normal' chord
 369 (define (chord::subtractions chord-pitches)
 370   (let ((tonic (car chord-pitches)))
 371     (let loop ((step 1) (pitches chord-pitches) (subtractions '()))
 372       (if (pair? pitches)
 373         (let* ((pitch (car pitches))
 374                (p-step (+ (- (pitch::note-pitch pitch)
 375                              (pitch::note-pitch tonic))
 376                           1)))
 377           ;; pitch is an subtraction if
 378           ;; a step is missing or
 379           (if (> p-step step)
 380             (loop (+ step 2) pitches
 381                 (cons (chord::step-pitch tonic step) subtractions))
 382           ;; there are no pitches left, but base thirds are not yet done and
 383           (if (and (<= step 5)
 384                    (= (length pitches) 1))
 385             ;; present pitch is not missing step
 386             (if (= p-step step)
 387               (loop (+ step 2) pitches subtractions)
 388               (loop (+ step 2) pitches
 389                     (cons (chord::step-pitch tonic step) subtractions)))
 390             (if (= p-step step)
 391               (loop (+ step 2) (cdr pitches) subtractions)
 392               (loop step (cdr pitches) subtractions)))))
 393         (reverse subtractions)))))
 394
 395 ;; combine tonic, user-specified chordname,
 396 ;; additions, subtractions and base or inversion to chord name
 397 ;;
 398 (define (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)
 399   (apply append
 400          '(rows)
 401          (pitch->text-banter tonic)
 402          (if user-name user-name '())
 403          ;; why does list->string not work, format seems only hope...
 404          (if (and (string-match "super" (format "~s" user-name))
 405                   (or (pair? additions)
 406                       (pair? subtractions)))
 407              '((super "/"))
 408              '())
 409          (let loop ((from additions) (to '()))
 410            (if (pair? from)
 411                (let ((p (car from)))
 412                  (loop (cdr from)
 413                        (append to
 414                                (cons
 415                                 (list 'super (step->text-banter p))
 416                                 (if (or (pair? (cdr from))
 417                                         (pair? subtractions))
 418                                     '((super "/"))
 419                                     '())))))
 420                to))
 421          (let loop ((from subtractions) (to '()))
 422            (if (pair? from)
 423                  (let ((p (car from)))
 424                    (loop (cdr from)
 425                          (append to
 426                                  (cons '(super "no")
 427                                        (cons
 428                                         (list 'super (step->text-banter p))
 429                                         (if (pair? (cdr from))
 430                                             '((super "/"))
 431                                             '()))))))
 432                  to))
 433          (if (and (pair? base-and-inversion)
 434                   (or (car base-and-inversion)
 435                       (cdr base-and-inversion)))
 436              (cons "/" (append
 437                         (if (car base-and-inversion)
 438                             (pitch->text
 439                              (car base-and-inversion))
 440                             (pitch->text
 441                              (cdr base-and-inversion)))
 442                         '()))
 443              '())
 444          '()))
 445
 446 (define (chord::name-banter tonic user-name pitches base-and-inversion)
 447   (let ((additions (chord::additions pitches))
 448         (subtractions (chord::subtractions pitches)))
 449     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 450
 451 ;; american chordnames use no "no",
 452 ;; but otherwise very similar to banter for now
 453 (define (chord::name-american tonic user-name pitches base-and-inversion)
 454   (let ((additions (chord::additions pitches))
 455         (subtractions #f))
 456     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 457
 458 ;; Jazz style--basically similar to american with minor changes
 459 (define (chord::name-jazz tonic user-name pitches base-and-inversion)
 460   (let ((additions (chord::additions pitches))
 461         (subtractions #f))
 462     (chord::inner-name-banter tonic user-name additions subtractions base-and-inversion)))
 463
 464 ;; C++ entry point
 465 ;;
 466 ;; Check for each subset of chord, full chord first, if there's a
 467 ;; user-override.  Split the chord into user-overridden and to-be-done
 468 ;; parts, complete the missing user-override matched part with normal
 469 ;; chord to be name-calculated.
 470 ;;
 471 (define (default-chord-name-function style pitches base-and-inversion)
 472   ;(display "pitches:") (display  pitches) (newline)
 473   ;(display "style:") (display  style) (newline)
 474   ;(display "b&i:") (display  base-and-inversion) (newline)
 475   (let ((diff (pitch::diff '(0 0 0) (car pitches)))
 476         (name-func
 477           (ly-eval (string->symbol (string-append "chord::name-" style))))
 478         (names-alist
 479           (ly-eval (string->symbol (string-append "chord::names-alist-" style)))))
 480   (let loop ((note-names (reverse pitches))
 481              (chord '())
 482              (user-name #f))
 483     (if (pair? note-names)
 484       (let ((entry (assoc
 485                      (reverse
 486                        (map (lambda (x)
 487                               (pitch->note-name (pitch::transpose x diff)))
 488                             note-names))
 489                      names-alist)))
 490         (if entry
 491           ;; urg? found: break loop
 492           (loop '() chord (cdr entry))
 493           (loop (cdr note-names) (cons (car note-names) chord) #f)))
 494       (let* ((transposed (if pitches
 495                            (map (lambda (x) (pitch::transpose x diff)) chord)
 496                            '()))
 497              (matched (if (= (length chord) 0)
 498                           3
 499                           (- (length pitches) (length chord))))
 500              (completed
 501               (append (do ((i matched (- i 1))
 502                            (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
 503                            ((= i 0) base)
 504                            ())
 505                   transposed)))
 506       (name-func (car pitches) user-name completed base-and-inversion))))))
 507
 508