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