Hi
I'm not gonna work on the (still incomplete) definitions of the jazz style
for a while so here's my result so far. I worked it out in 1.3.98 and I
understand that the chords are currently broken, but anyway...
--
Atte André Jensen
;;; chord.scm -- to be included in/to replace chord-name.scm
;;; 2000 [EMAIL PROTECTED]
;;;
(use-modules
(ice-9 debug)
;; urg, these two only to guess if a '/' is needed to separate
;; user-chord-name and additions/subtractions
(ice-9 format)
(ice-9 regex)
)
;;
;; (octave notename accidental)
;;
;;
;; text: scm markup text -- see font.scm and input/test/markup.ly
;;
;; TODO
;;
;; * clean split of base/banter/american stuff
;; * text definition is rather ad-hoc
;; * do without format module
;; * finish and check american names
;; * make notename (tonic) configurable from mudela
;; * fix append/cons stuff in inner-name-banter
;;
;;;;;;;;;
(define chord::names-alist-banter '())
(set! chord::names-alist-banter
(append
'(
; C iso C.no3.no5
(((0 . 0)) . #f)
; C iso C.no5
(((0 . 0) (2 . 0)) . #f)
; Cm iso Cm.no5
(((0 . 0) (2 . -1)) . ("m"))
; C2 iso C2.no3
(((0 . 0) (1 . 0) (4 . 0)) . (super "2"))
; C4 iso C4.no3
(((0 . 0) (3 . 0) (4 . 0)) . (super "4"))
; Cdim iso Cm5-
(((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
; Co iso Cm5-7-
; urg
(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super "o"))
; Cdim9
(((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9")))
(((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super
"11")))
)
chord::names-alist-banter))
;; NOTE: Duplicates of chord names defined elsewhere occur in this list
;; in order to prevent spurious superscripting of various chord names,
;; such as maj7, maj9, etc.
;;
;; See input/test/american-chords.ly
;;
;; James Hammons, <[EMAIL PROTECTED]>
(define chord::names-alist-american '())
(set! chord::names-alist-american
(append
'(
(((0 . 0)) . #f)
(((0 . 0) (2 . 0)) . #f)
;; Root-fifth chord
(((0 . 0) (4 . 0)) . ("5"))
;; Common triads
(((0 . 0) (2 . -1)) . ("m"))
(((0 . 0) (3 . 0) (4 . 0)) . ("sus"))
(((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
;Alternate: (((0 . 0) (2 . -1) (4 . -1)) . ((super "o")))
(((0 . 0) (2 . 0) (4 . 1)) . ("aug"))
;Alternate: (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
(((0 . 0) (1 . 0) (4 . 0)) . ("2"))
;; Common seventh chords
(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (rows (super "o") "7"))
(((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
(((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7"))
(((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ("7"))
(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ("m(maj7)"))
;jazz: the delta, see jazz-chords.ly
;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (super ((font-family . "math")
"N"))
;; slashed o
(((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (rows ((raise . 1) "o") ((raise .
0.5) ((kern . -0.5) ((font-size . "-3") "/"))) "7")) ; slashed o
(((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
(((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (rows "maj7" ((font-size . "-2")
((raise . 0.2) (music (named ("accidentals--1"))))) "5"))
(((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows "7" ((font-size . "-2") ((raise
. 0.2) (music (named ("accidentals--1"))))) "5"))
(((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ("7sus4"))
;; Common ninth chords
(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . ("6/9")) ;; we don't want the
'/no7'
(((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ("6"))
(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ("m6"))
(((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ("add9"))
(((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0)) . ("maj9"))
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . ("9"))
(((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ("m9"))
)
chord::names-alist-american))
;; Jazz chords, by Atte André Jensen <[EMAIL PROTECTED]>
;; NBs: This uses the american list as a base.
;; Some defs take up more than one line, be carefull when messing with ;'s!!
(define chord::names-alist-jazz '())
(set! chord::names-alist-jazz
(append
'(
;; major chords
; major sixth chord = 6
(((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . (((raise . 0.5) "6")))
; major seventh chord = triangle
(((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . (((raise . 0.5)((font-family . "math")
"M"))))
; major chord add nine = add9
(((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . (((raise . 0.5) "add9")))
; major sixth chord with nine = 6/9
(((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0)) . (((raise . 0.5) "6/9")))
;; minor chords
; minor sixth chord = m6
(((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . (rows("m")((raise . 0.5) "6")))
; minor major seventh chord = m triangle
(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (rows ("m") ((raise . 0.5)((font-family
. "math") "M"))))
; minor seventh chord = m7
(((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . (rows("m")((raise . 0.5) "7")))
; minor sixth nine chord = m6/9
(((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . (rows("m")((raise . 0.5)
"6/9")))
; minor with added nine chord = madd9
(((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . (rows("m")((raise . 0.5) "add9")))
; minor ninth chord = m9
(((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . (rows("m")((raise . 0.5) "9")))
;; dominant chords
; dominant seventh = 7
(((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . (((raise . 0.5) "7")))
; augmented dominant = +7
;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (((raise . 0.5) "+7"))) ; +7 with both
raised
(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows("+")((raise . 0.5) "7"))) ; +7
with 7 raised
;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (rows((raise . 0.5) "7(")
; ((raise . 0.3)(music (named ("accidentals-1"))))
; ((raise . 0.5) "5)"))); 7(#5)
; dominant flat 5 = 7(b5)
(((0 . 0) (2 . 0) (4 . -1) (6 . -1)) . (rows((raise . 0.5) "7(")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.5) "5)")))
; dominant 9 = 7(9)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) . (((raise . 0.8)"7(9)")))
; dominant flat 9 = 7(b9)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) . (
((raise . 0.8)"7(")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.8)"9)")))
; dominant sharp 9 = 7(#9)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) . (
((raise . 0.8)"7(")
((raise . 0.3)(music (named ("accidentals-1"))))
((raise . 0.8)"9)")))
; dominant 13 = 7(13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) . (((raise . 0.8)"7(13)")))
; dominant flat 13 = 7(b13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) . (
((raise . 0.8)"7(")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.8)"13)")))
; dominant 9, 13 = 7(9,13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) . (((raise . 0.8)"7(9,
13)")))
; dominant flat 9, 13 = 7(b9,13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) . (
((raise . 0.8)"7(")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.8)"9, 13)")))
; dominant sharp 9, 13 = 7(#9,13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) . (
((raise . 0.8)"7(")
((raise . 0.3)(music (named ("accidentals-1"))))
((raise . 0.8)"9, 13)")))
; dominant 9, flat 13 = 7(9,b13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) . (
((raise . 0.8)"7(9, ")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.8)"13)")))
; dominant flat 9, flat 13 = 7(b9,b13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) . (
((raise . 0.8)"7(")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.8)"9, ")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.8)"13)")))
; dominant sharp 9, flat 13 = 7(#9,b13)
(((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) . (
((raise . 0.8)"7(")
((raise . 0.3)(music (named ("accidentals-1"))))
((raise . 0.8)"9, ")
((raise . 0.3)(music (named ("accidentals--1"))))
((raise . 0.8)"13)")))
;; diminished chord(s)
; diminished seventh chord = o
;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (((raise . 0.8)"o"))); works, but "o"
is a little big
(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (("°")))
;; half diminshed chords
; half diminished seventh chord = slashed o
(((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8)"ř"))); works, but "ř"
is a little big
; half diminished seventh chord with major 9 = slashed o cancelation 9
(((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . (
((raise . 0.8)"ř(")
((raise . 0.3)(music (named ("accidentals-0"))))
((raise . 0.8)"9)"))); works, but "ř" is a little big
;; Missing jazz chord definitions go here (note new syntax: see american for hints)
)
chord::names-alist-american))
;;;;;;;;;;
(define (pitch->note-name pitch)
(cons (cadr pitch) (caddr pitch)))
(define (pitch->text pitch)
(cons
(make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65)))
(if (= (caddr pitch) 0)
'()
(list
(append '(music)
(list
(append '(named)
(list
(append '((font-size . "-2"))
(list (append '((raise . 0.6))
(list
(string-append "accidentals-"
(number->string (caddr
pitch)))))))))))))))
(define (step->text pitch)
(string-append
(number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))
(case (caddr pitch)
((-2) "--")
((-1) "-")
((0) "")
((1) "+")
((2) "++"))))
(define (pitch->text-banter pitch)
(pitch->text pitch))
(define (step->text-banter pitch)
(if (= (cadr pitch) 6)
(case (caddr pitch)
((-2) "7-")
((-1) "7")
((0) "maj7")
((1) "7+")
((2) "7+"))
(step->text pitch)))
(define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
(define (pitch::semitone pitch)
(+ (* (car pitch) 12)
(vector-ref pitch::semitone-vec (modulo (cadr pitch) 7))
(caddr pitch)))
(define (pitch::transpose pitch delta)
(let ((simple-octave (+ (car pitch) (car delta)))
(simple-notename (+ (cadr pitch) (cadr delta))))
(let ((octave (+ simple-octave (quotient simple-notename 7)))
(notename (modulo simple-notename 7)))
(let ((accidental (- (+ (pitch::semitone pitch) (pitch::semitone delta))
(pitch::semitone `(,octave ,notename 0)))))
`(,octave ,notename ,accidental)))))
(define (pitch::diff pitch tonic)
(let ((simple-octave (- (car pitch) (car tonic)))
(simple-notename (- (cadr pitch) (cadr tonic))))
(let ((octave (+ simple-octave (quotient simple-notename 7)
(if (< simple-notename 0) -1 0)))
(notename (modulo simple-notename 7)))
(let ((accidental (- (pitch::semitone pitch)
(pitch::semitone tonic)
(pitch::semitone `(,octave ,notename 0)))))
`(,octave ,notename ,accidental)))))
(define (pitch::note-pitch pitch)
(+ (* (car pitch) 7) (cadr pitch)))
(define (chord::step tonic pitch)
(- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
;; text: list of word
;; word: string + optional list of property
;; property: align, kern, font (?), size
(define chord::minor-major-vec (list->vector '(0 -1 -1 0 -1 -1 0)))
;; compute the relative-to-tonic pitch that goes with 'step'
(define (chord::step-pitch tonic step)
;; urg, we only do this for thirds
(if (= (modulo step 2) 0)
'(0 0 0)
(let loop ((i 1) (pitch tonic))
(if (= i step) pitch
(loop (+ i 2)
(pitch::transpose
pitch `(0 2 ,(vector-ref chord::minor-major-vec
;; -1 (step=1 -> vector=0) + 7 = 6
(modulo (+ i 6) 7)))))))))
;; find the pitches that are not part of `normal' chord
(define (chord::additions chord-pitches)
(let ((tonic (car chord-pitches)))
;; walk the chord steps: 1, 3, 5
(let loop ((step 1) (pitches chord-pitches) (additions '()))
(if (pair? pitches)
(let* ((pitch (car pitches))
(p-step (+ (- (pitch::note-pitch pitch)
(pitch::note-pitch tonic))
1)))
;; pitch is an addition if
(if (or
;; it comes before this step or
(< p-step step)
;; its step is even or
(= (modulo p-step 2) 0)
;; has same step, but different accidental or
(and (= p-step step)
(not (equal? pitch (chord::step-pitch tonic step))))
;; is the last of the chord and not one of base thirds
(and (> p-step 5)
(= (length pitches) 1)))
(loop step (cdr pitches) (cons pitch additions))
(if (= p-step step)
(loop step (cdr pitches) additions)
(loop (+ step 2) pitches additions))))
(reverse additions)))))
;; find the pitches that are missing from `normal' chord
(define (chord::subtractions chord-pitches)
(let ((tonic (car chord-pitches)))
(let loop ((step 1) (pitches chord-pitches) (subtractions '()))
(if (pair? pitches)
(let* ((pitch (car pitches))
(p-step (+ (- (pitch::note-pitch pitch)
(pitch::note-pitch tonic))
1)))
;; pitch is an subtraction if
;; a step is missing or
(if (> p-step step)
(loop (+ step 2) pitches
(cons (chord::step-pitch tonic step) subtractions))
;; there are no pitches left, but base thirds are not yet done and
(if (and (<= step 5)
(= (length pitches) 1))
;; present pitch is not missing step
(if (= p-step step)
(loop (+ step 2) pitches subtractions)
(loop (+ step 2) pitches
(cons (chord::step-pitch tonic step) subtractions)))
(if (= p-step step)
(loop (+ step 2) (cdr pitches) subtractions)
(loop step (cdr pitches) subtractions)))))
(reverse subtractions)))))
;; combine tonic, user-specified chordname,
;; additions, subtractions and base or inversion to chord name
;;
(define (chord::inner-name-banter tonic user-name additions subtractions
base-and-inversion)
(apply append
'(rows)
(pitch->text-banter tonic)
(if user-name user-name '())
;; why does list->string not work, format seems only hope...
(if (and (string-match "super" (format "~s" user-name))
(or (pair? additions)
(pair? subtractions)))
'((super "/"))
'())
(let loop ((from additions) (to '()))
(if (pair? from)
(let ((p (car from)))
(loop (cdr from)
(append to
(cons
(list 'super (step->text-banter p))
(if (or (pair? (cdr from))
(pair? subtractions))
'((super "/"))
'())))))
to))
(let loop ((from subtractions) (to '()))
(if (pair? from)
(let ((p (car from)))
(loop (cdr from)
(append to
(cons '(super "no")
(cons
(list 'super (step->text-banter p))
(if (pair? (cdr from))
'((super "/"))
'()))))))
to))
(if (and (pair? base-and-inversion)
(or (car base-and-inversion)
(cdr base-and-inversion)))
(cons "/" (append
(if (car base-and-inversion)
(pitch->text
(car base-and-inversion))
(pitch->text
(cdr base-and-inversion)))
'()))
'())
'()))
(define (chord::name-banter tonic user-name pitches base-and-inversion)
(let ((additions (chord::additions pitches))
(subtractions (chord::subtractions pitches)))
(chord::inner-name-banter tonic user-name additions subtractions
base-and-inversion)))
;; american chordnames use no "no",
;; but otherwise very similar to banter for now
(define (chord::name-american tonic user-name pitches base-and-inversion)
(let ((additions (chord::additions pitches))
(subtractions #f))
(chord::inner-name-banter tonic user-name additions subtractions
base-and-inversion)))
;; Jazz style--basically similar to american with minor changes
(define (chord::name-jazz tonic user-name pitches base-and-inversion)
(let ((additions (chord::additions pitches))
(subtractions #f))
(chord::inner-name-banter tonic user-name additions subtractions
base-and-inversion)))
;; C++ entry point
;;
;; Check for each subset of chord, full chord first, if there's a
;; user-override. Split the chord into user-overridden and to-be-done
;; parts, complete the missing user-override matched part with normal
;; chord to be name-calculated.
;;
(define (default-chord-name-function style pitches base-and-inversion)
;(display "pitches:") (display pitches) (newline)
;(display "style:") (display style) (newline)
;(display "b&i:") (display base-and-inversion) (newline)
(let ((diff (pitch::diff '(0 0 0) (car pitches)))
(name-func
(ly-eval (string->symbol (string-append "chord::name-" style))))
(names-alist
(ly-eval (string->symbol (string-append "chord::names-alist-" style)))))
(let loop ((note-names (reverse pitches))
(chord '())
(user-name #f))
(if (pair? note-names)
(let ((entry (assoc
(reverse
(map (lambda (x)
(pitch->note-name (pitch::transpose x diff)))
note-names))
names-alist)))
(if entry
;; urg? found: break loop
(loop '() chord (cdr entry))
(loop (cdr note-names) (cons (car note-names) chord) #f)))
(let* ((transposed (if pitches
(map (lambda (x) (pitch::transpose x diff)) chord)
'()))
(matched (if (= (length chord) 0)
3
(- (length pitches) (length chord))))
(completed
(append (do ((i matched (- i 1))
(base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
((= i 0) base)
())
transposed)))
(name-func (car pitches) user-name completed base-and-inversion))))))
%
% Make sure the correct msamxx.tfm is where lily can find it
% (ie cwd or lily's tfm dir).
%
% For normal (20pt) paper, do
%
% cp locate `msam9.tfm` $LILYPONDPREFIX/tfm
%
chord = \notes\transpose c''\chords{
\property ChordNames.ChordNames \push #'style = #"jazz"
% major chords
c
c:6 % 6 = major triad with added sixth
c:maj % triangle = maj
c:6.9^7 % 6/9
c:9^7 % add9
% minor chords
c:m % m = minor triad
c:m.6 % m6 = minor triad with added sixth
c:m.7+ % m triangle = minor major seventh chord
c:3-.6.9^7 % m6/9
c:m.7 % m7
c:3-.9 % m9
c:3-.9^7 % madd9
% dominant chords
c:7 % 7 = dominant
c:7.5+ % +7 = augmented dominant
c:7.5- % 7b5 = hard diminished dominant
c:9 % 7(9)
c:9- % 7(b9)
c:9+ % 7(#9)
c:13^9.11 % 7(13)
c:13-^9.11 % 7(b13)
c:13^11 % 7(9,13)
c:13.9-^11 % 7(b9,13)
c:13.9+^11 % 7(#9,13)
c:13-^11 % 7(9,b13)
c:13-.9-^11 % 7(b9,b13)
c:13-.9+^11 % 7(#9,b13)
% half diminished chords
c:m5-.7 % slashed o = m7b5
c:9.3-.5- % ř7(pure 9)
% diminished chords
c:m5-.7- % o = diminished seventh chord
}
\score{
<
\context ChordNames \chord
\context Staff \chord
>
\paper
{
\translator { \ChordNamesContext ChordNames \push #'word-space = #1 }
% \translator { \LyricsContext textScriptWordSpace = #0.3 }
}
}
