-
- (let* ((result (chord::exceptions-lookup-helper
- (chord::restyle 'chord::names-alist- style)
- steps '() #f))
- (exception-part (car result))
- (unmatched-steps (cdr result))
- (matched-steps (if (= (length unmatched-steps) 0)
- 3
- (+ 1 (- (length steps)
- (length unmatched-steps)))))
- (unmatched-with-1-3-5
- (append (do ((i matched-steps (- i 1))
- (base '() (cons `(0 ,(* (- i 1) 2) 0) base)))
- ((= i 0) base)
- ())
- unmatched-steps)))
- (list exception-part unmatched-with-1-3-5)))
-
-
-(define (chord::name->markup style tonic steps bass-and-inversion)
- (write-me tonic)
- (write-me steps)
- (let* ((lookup (write-me (chord::exceptions-lookup style steps)))
- (exception-part (write-me (car lookup)))
- (unmatched-steps (cadr lookup))
- (func (chord::restyle 'chord::name- style))
- )
-
-
- (func tonic exception-part unmatched-steps bass-and-inversion steps)))
-
-;; 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.
-;;
-;; CHORD: (pitches (bass . inversion))
-(define-public (chord->markup style chord)
- (let* ((pitches (map c++-pitch->scm (car chord)))
- (modifiers (cdr chord))
- (bass-and-inversion (if (pair? modifiers)
- (cons (c++-pitch->scm (car modifiers))
- (c++-pitch->scm (cdr modifiers)))
- '(() . ())))
- (diff (pitch::diff '(0 0 0) (car pitches)))
- (steps (if (cdr pitches) (map (lambda (x)
- (pitch::transpose x diff))
- (cdr pitches))
- '())))
-
- (chord::name->markup style (car pitches) steps bass-and-inversion)))
-
-;;;
-;;; American style
-;;;
-
-
-;; 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, <jlhamm@pacificnet.net>
-;;
-
-;; DONT use non-ascii characters, even if ``it works'' in Windows
-
-
-(define chord::names-alist-american
-
- `(
- (((0 . 0)) . ,empty-markup)
- (((0 . 0) (2 . 0)) . ,empty-markup)
- ;; Root-fifth chord
- (((0 . 0) (4 . 0)) . ,(make-simple-markup "5"))
- ;; Common triads
- (((0 . 0) (2 . -1)) . ,(make-simple-markup "m"))
- (((0 . 0) (3 . 0) (4 . 0)) . ,(make-simple-markup "sus"))
- (((0 . 0) (2 . -1) (4 . -1)) . ,(make-simple-markup "dim"))
-;Alternate: (((0 . 0) (2 . -1) (4 . -1)) . ("" (super "o")))
- (((0 . 0) (2 . 0) (4 . 1)) . ,(make-simple-markup "aug"))
-;Alternate: (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
- (((0 . 0) (1 . 0) (4 . 0)) . ,(make-simple-markup "2"))
- ;; Common seventh chords
- (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .
- ,(make-line-markup
- (list
- (make-super-markup (make-simple-markup "o"))
- (make-simple-markup " 7"))))
- (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ,(make-simple-markup "maj7"))
- ;; urg! should use (0 . 0 2 . -1) -> "m", and add "7" to that!!
- (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ,(make-simple-markup "m7"))
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1)) . ,(make-simple-markup "7"))
- (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . ,(make-simple-markup "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)) .
- ,(make-line-markup
- (list
- (make-super-markup
- (make-combine-markup (make-simple-markup "o")
- (make-simple-markup "/")))
- (make-simple-markup " 7"))))
- (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ,(make-simple-markup "aug7"))
- (((0 . 0) (2 . 0) (4 . -1) (6 . 0))
- . ,(make-line-markup
- (list
- (make-simple-markup "maj7")
- (make-small-markup
- (make-raise-markup 0.2 (accidental-markup -1)))
- (make-simple-markup "5"))))
- (((0 . 0) (2 . 0) (4 . -1) (6 . -1)) .
- ,(make-line-markup
- (list
- (make-simple-markup "7")
- (make-small-markup (make-raise-markup 0.2 (accidental-markup -1)))
- (make-simple-markup "5"))))
- (((0 . 0) (3 . 0) (4 . 0) (6 . -1)) . ,(make-simple-markup "7sus4"))
- ;; Common ninth chords
- (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0))
- . ,(make-simple-markup "6/9")) ;; we don't want the '/no7'
- (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) . ,(make-simple-markup "6"))
- (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) . ,(make-simple-markup "m6"))
- (((0 . 0) (2 . 0) (4 . 0) (1 . 0)) . ,(make-simple-markup "add9"))
- (((0 . 0) (2 . 0) (4 . 0) (6 . 0) (1 . 0))
- . ,(make-simple-markup "maj9"))
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0))
- . ,(make-simple-markup "9"))
- (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0))
- . ,(make-simple-markup "m9"))
-
- ))
-
-;; American style chordnames use no "no",
-;; but otherwise very similar to banter for now
-(define-public (chord::name-american tonic exception-part unmatched-steps
- bass-and-inversion steps)
- (let ((additions (chord::additions unmatched-steps))
- (subtractions #f))
- (chord::inner-name-banter tonic exception-part additions subtractions
- bass-and-inversion steps)))
-
-;;;
-;;; Jazz style
-;;;
-
-
-
-;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
-;; NBs: This uses the american list as a bass.
-;; Some defs take up more than one line,
-;; be carefull when messing with ;'s!!
-
-
-;; FIXME
-;;
-;; This is getting out-of hand? Only exceptional chord names that
-;; cannot be generated should be here.
-;; Maybe we should have inner-name-jazz and inner-name-american functions;
-;;
-;;
-;;
-;; DONT use non-ascii characters, even if ``it works'' in Windows
-
-(define mathm-markup-object
- (make-override-markup '(font-family . math) (make-simple-markup "M")))
-
-(define mraise-arg `(make-line-markup
- (list
- ,(make-simple-markup "m")
- (make-raise-markup 0.5 (make-simple-markup arg)))))
-
-(define (raise-some-for-jazz arg-list)
- (define (do-one x)
- (case x
- ("@" (make-raise-markup 0.3 ,(accidental-markup -1)))
- ("#" (make-raise-markup 0.3 ,(accidental-markup 1)))
- (else (make-raise-markup 0.8 ,x))))
-
- (make-line-markup
- (list (map do-one arg-list))))
-
-(define chord::names-alist-jazz
- (append
- '(
- ;; major chords
- ; major sixth chord = 6
- (((0 . 0) (2 . 0) (4 . 0) (5 . 0)) .
- ,(make-raise-markup 0.5 (make-simple-markup "6")))
- ; major seventh chord = triangle
- ;; shouldn't this be a filled black triange, like this: ? --jcn
- ;; (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . (((raise . 0.5)((font-family . math) "N"))))
- (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .
- ,(make-raise-markup 0.5 mathm-markup-object))
-
- ; major chord add nine = add9
- (((0 . 0) (2 . 0) (4 . 0) (1 . 0))
- . ,(make-raise-markup 0.5 (make-simple-markup "add9")))
- ; major sixth chord with nine = 6/9
- (((0 . 0) (2 . 0) (4 . 0) (5 . 0) (1 . 0))
- . ,(make-raise-markup 0.5 (make-simple-markup "add9")))
-
- ;; minor chords
- ; minor sixth chord = m6
- (((0 . 0) (2 . -1) (4 . 0) (5 . 0)) .
- ,(mraise-arg "6"))
-
- ;; minor major seventh chord = m triangle
- ;; shouldn't this be a filled black triange, like this: ? --jcn
- ;;(((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (columns ("m") ((raise . 0.5)((font-family . math) "N"))))
- (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) .
- ,(make-line-markup
- (list ((make-simple-markup "m") mathm-markup-object))))
- ; minor seventh chord = m7
- (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ,(mraise-arg "7"))
- ; minor sixth nine chord = m6/9
- (((0 . 0) (2 . -1) (4 . 0) (5 . 0) (1 . 0)) . ,(mraise-arg "6/9"))
-
- ; minor with added nine chord = madd9
- (((0 . 0) (2 . -1) (4 . 0) (1 . 0)) . ,(mraise-arg "madd9"))
-
- ; minor ninth chord = m9
- (((0 . 0) (2 . -1) (4 . 0) (6 . -1) (1 . 0)) . ,(mraise-arg "add9"))
-
- ;; dominant chords
- ; dominant seventh = 7
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1))
- . ,(make-raise-markup 0.5 (make-simple-markup "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)) .
- ,(make-line-markup
- (list
- (make-simple-markup "+")
- ;; +7 with 7 raised
- (make-raise-markup 0.5 (make-simple-markup "7")))))
- ;(((0 . 0) (2 . 0) (4 . +1) (6 . -1)) . (columns((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))
- . ,(raise-some-for-jazz '( "7(" "@" "5)" )))
-
- ; dominant 9 = 7(9)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0)) .
- ,(raise-some-for-jazz '("7(9)")))
- ; dominant flat 9 = 7(b9)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1)) .
- ,(raise-some-for-jazz '("7(" "@" "9)")))
-
- ; dominant sharp 9 = 7(#9)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1)) .
- ,(raise-some-for-jazz '("7(" "#" "9)")))
-
- ; dominant 13 = 7(13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . 0)) .
- ,(raise-some-for-jazz "7(13)"))
- ; dominant flat 13 = 7(b13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (5 . -1)) .
- ,(raise-some-for-jazz '( "7(" "@" "13)")))
-
- ; dominant 9, 13 = 7(9,13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . 0)) .
- ,(raise-some-for-jazz '("7(9, 13)")))
- ; dominant flat 9, 13 = 7(b9,13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . 0)) .
- ,(raise-some-for-jazz '("7(" "@" "9, 13)")))
-
- ; dominant sharp 9, 13 = 7(#9,13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . 0)) .
- ,(raise-some-for-jazz '("7(" "#" "9,13)")))
-
- ; dominant 9, flat 13 = 7(9,b13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . 0) (5 . -1)) .
- ,(raise-some-for-jazz "7(9, " "@" "13)"))
-
- ; dominant flat 9, flat 13 = 7(b9,b13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . -1) (5 . -1)) .
- ,(raise-some-for-jazz '("7(" "@" "9, " "@" "13)")))
-
- ; dominant sharp 9, flat 13 = 7(#9,b13)
- (((0 . 0) (2 . 0) (4 . 0) (6 . -1) (1 . +1) (5 . -1)) .
- ,(raise-some-for-jazz '("7(" "#" "9, " "@" "13)")))
-
- ;; diminished chord(s)
- ; diminished seventh chord = o
-
-
- ;; DONT use non-ascii characters, even if ``it works'' in Windows
-
- ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ((raise . 0.8) (size . -2) ("o")))
- (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .
- ,(make-super-markup (make-simple-markup "o")))
-
- ;; half diminshed chords
- ;; half diminished seventh chord = slashed o
- ;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8) "/o")))
- (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) .
- ,(make-line-markup
- (list
- (make-super-markup
- (make-combine-markup
- (make-simple-markup "o") (make-simple-markup "/")))
- (make-simple-markup " 7"))))
- ; half diminished seventh chord with major 9 = slashed o cancelation 9
- (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) .
- ,(raise-some-for-jazz '("/o(" "!" "9)")))
-
-;; Missing jazz chord definitions go here (note new syntax: see american for hints)
-
- )
- chord::names-alist-american))
-
-(define (step->markup-alternate-jazz pitch)
- (make-line-markup
- (list
- (accidental-markup (caddr pitch))
- (make-simple-markup
- (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))))))
-
-(define (step->markup-jazz pitch)
- (if (= (cadr pitch) 6)
- (case (caddr pitch)
- ;; sharp 7 only included for completeness?
- ((-2) (make-line-markup
- (list
- (accidental-markup -1)
- (make-simple-markup "7"))))
- ((-1) (make-simple-markup "7"))
- ((0) (make-simple-markup "maj7"))
- ;;((0) (make-line-markup
- ;; (list (make-simple-markup "maj7"))))
- ((1) (make-line-markup
- (list
- (accidental-markup 1) (make-simple-markup "7"))))
- ((2) (make-line-markup
- (list (accidental-markup 1)
- (make-simple-markup "7")))))
- (step->markup-alternate-jazz pitch)))
-
-(define (xchord::additions->markup-jazz additions subtractions)
- (if (pair? additions)
- (make-line-markup
- (list
- (let ((step (step->markup-jazz (car additions))))
- (if (or (pair? (cdr additions))
- (pair? subtractions))
- (make-line-markup (list step (make-simple-markup "/")))
- step))
- (chord::additions->markup-jazz (cdr additions) subtractions)))
- empty-markup))
-
-(define (chord::>5? x)
- (or (> (car x) 0)
- (> (cadr x) 4)))
-
-
-;; FIXME:
-;; Perhaps all logic like this should be done earlier,
-;; so that in this markup-construction printing phase
-;; we can just blindly create markup from all additions.
-;;
-;; This depends maybe on the fact of code sharing,
-;; in this layout, we can share the functions chord::additions
-;; and chord::subtractions with banter.
-(define (chord::additions->markup-jazz additions subtractions)
- ;; FIXME
- (make-line-markup
- (list
- (chord::additions<=5->markup-jazz
- (filter-out-list chord::>5? additions)
- (filter-out-list chord::>5? subtractions))
- (chord::additions>5->markup-jazz
- (filter-list chord::>5? additions)
- (filter-list chord::>5? subtractions)))))
-
-
-;; FIXME
-(define (chord::additions<=5->markup-jazz additions subtractions)
- (let ((sus (chord::sus-four-jazz additions)))
- (if (pair? sus)
- (make-line-markup
- (list (make-simple-markup "sus")
- (step->markup-jazz (car sus))))
- empty-markup)))
-
-
-(define (chord::additions>5->markup-jazz additions subtractions)
- "
-Compose markup of all additions
-
- * if there's a subtraction:
- - add `add'
- - list all up to highest
- * list all steps that are below an chromatically altered step
- "
-
- (make-line-markup
- (list
- (if (not (null? subtractions))
- (make-simple-markup "add")
- empty-markup)
- ;; this is totally incomprehensible. Fix me, and docme.
-
- ;; The function >5markup-jazz-helper cdrs through the list
- ;; of additions in reverse order, ie, for c 7 9+:
- ;; (1 1 1), (0 6 0), done
-
- ;; For each step, it creates a markup, if necessary, and
- ;; cons's it to the list.
-
- ;; The list is reversed.
- (let* ((radds (reverse additions))
- (rmarkups (chord::additions>5->markup-jazz-helper
- radds
- subtractions
- (if (or (null? subtractions) (null? radds))
- #f (car radds)))))
- (if (null? rmarkups)
- empty-markup
- (make-line-markup (reverse rmarkups)))))))
-
-
-
-(define (chord::additions>5->markup-jazz-helper additions subtractions list-step)
- "
-Create markups for all additions
-If list-step != #f, list all steps down to 5
-If we encounter a chromatically altered step, turn on list-step