From: Jan Nieuwenhuizen Date: Tue, 10 Jun 2003 16:43:46 +0000 (+0000) Subject: * ly/chord-modifiers-init.ly: X-Git-Tag: release/1.7.21~31 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=5a682bc69d9c7c70b161d002bc6e470303a3693f;p=lilypond.git * ly/chord-modifiers-init.ly: * ly/engraver-init.ly (ScoreContext): Add chordNameExceptionsFull and chordNameExceptionsPartial for new chord names. * input/test/chord-names-dpnj.ly: * input/test/dpncnt.ly: Update. * scm/chord-name.scm: * scm/double-plus-new-chord-name.scm: Add compatibility for new chord selection and options. * ly/chord-modifiers-init.ly: Add exceptions * scm/define-translator-properties.scm (chordNameStyle) (chordNameExceptionsFull, chordNameExceptionsPartial): Add. --- diff --git a/ChangeLog b/ChangeLog index e4bf7d9a7d..c80609f62e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,21 @@ +2003-06-10 Jan Nieuwenhuizen + + * ly/chord-modifiers-init.ly: + * ly/engraver-init.ly (ScoreContext): Add chordNameExceptionsFull + and chordNameExceptionsPartial for new chord names. + + * input/test/chord-names-dpnj.ly: + * input/test/dpncnt.ly: Update. + + * scm/chord-name.scm: + * scm/double-plus-new-chord-name.scm: Add compatibility for new + chord selection and options. + + * ly/chord-modifiers-init.ly: Add exceptions + + * scm/define-translator-properties.scm (chordNameStyle) + (chordNameExceptionsFull, chordNameExceptionsPartial): Add. + 2003-06-10 Rune Zedeler * ly/property-init.ly (germanChords): Added. diff --git a/input/test/chord-names-dpnj.ly b/input/test/chord-names-dpnj.ly index 886b2065a2..b3fdac17e5 100644 --- a/input/test/chord-names-dpnj.ly +++ b/input/test/chord-names-dpnj.ly @@ -1,112 +1,117 @@ -\version "1.7.18" - \header { - texidoc = "Chord name scheme test -- double-plus-new-chord-name jazz" -} - -%% This should only be necessary if your kpathsea setup is broken -% -% 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/fonts/tfm -% - -scheme = \chords { - % 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 +texidoc = " Chord names are generated from a list pitches. The +functions constructing the names are customisable. This file shows +Jazz chords. Compare with chords-ignatzek.ly - % minor chords - c:m % m = minor triad - c:m6 % m6 = minor triad with added sixth - c:m7+ % m triangle = minor major seventh chord - c:3-.6.9^7 % m6/9 - c:m7 % 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- % o/7(pure 9) - - % diminished chords - c:m5-.7- % o = diminished seventh chord } -efullmusic = \notes { - - %% ? what 'bout maj7? - %% c:7 = \markup { \normal-size-super "maj7" } - - %% Choose your symbol for the fully diminished chord - %% American: - %% c:3-.5-.7- = \markup { "dim" } - %% Jazz: - %% c:3-.5-.7- - <>-\markup { \super " o" } +chs = \notes \transpose c c' +{ + <>1-"dpn" + <>% m = minor triad + <> + <> \break + <> + <> + <> % triangle = maj + <> + <> \break + <> + <> + <> + <>\break + <> % 6 = major triad with added sixth + <> % m6 = minor triad with added sixth + <> + <> \break + <> + <> + <> + <> \break + <> + <> + <> + <>\break + <> + <> + <> + <>\break + <> + <> + <> + <>\break + <> + <> + <> + <>\break + <> + <> + <> + <>\break + <> + <> % add9 + <> +} - %% Hmm, this ok? - %% c:7+ +efullmusic = \notes{ + <>1-\markup { "+" } <>-\markup { \normal-size-super - \override #'(font-family . math) "N" } + % \override #'(font-family . math) "N" } + \override #'(font-family . math) "M" } %%c:3.5.7 = \markup { \override #'(font-family . math) "M" } %%c:3.5.7 = \markup { \normal-size-super "maj7" } + + <>-\markup { \super "o" } % should be $\circ$ ? + <>-\markup { \super \combine "o" "/" } + <>-\markup { \super "o7" } } efull = #(sequential-music-to-chord-exceptions efullmusic #f) -epartialmusic = \notes { - %c:2^3 = - <>-\markup { \normal-size-super "2" } - %c:3- +epartialmusic = \notes{ + <>1-\markup { \normal-size-super "2" } <>-\markup { "m" } - %c:4 <>-\markup { \normal-size-super "sus4" } - %c:5^3 <>-\markup { \normal-size-super "5" } + + %% TODO, partial exceptions + <>-\markup { "m" }-\markup { \normal-size-super "sus4" } + <>-\markup { "m" }-\markup { \normal-size-super "sus2" } } epartial = #(sequential-music-to-chord-exceptions epartialmusic #f) -\score { - \notes < + +\score{ + < \context ChordNames { - %#(set-double-plus-new-chord-name-style 'banter - % `((separator . ,(make-simple-markup ":")) - % (full-exceptions . ,efull) - % (partial-exceptions . ,epartial))) +%{ + \property ChordNames.chordNameFunction = #double-plus-new-chord->markup + \property ChordNames.chordNameStyle = #'jazz +%} + + \property ChordNames.majorSevenSymbol = #whiteTriangleMarkup + \property ChordNames.chordNameSeparator = #(make-simple-markup "/") + \property ChordNames.chordNameExceptionsFull = #efull + \property ChordNames.chordNameExceptionsPartial = #epartial - #(set-double-plus-new-chord-name-style 'jazz - `((separator . ,(make-simple-markup ":")) - (full-exceptions . ,efull) - (partial-exceptions . ,epartial))) - \scheme } - \context Staff \transpose c c' \scheme - > + %% FIXME + %%\property ChordNames.chordNoteNamer = #'step->markup-ignatzek + %%chordRootNamer = #note-name->markup + + #(set-chord-name-style 'jazz) + + \chs + } + \context Staff \notes \transpose c c { \chs } + > + \paper{ + \translator { + \ChordNamesContext + ChordName \override #'word-space = #1 + } + } } -%% new-chords-done %% - + diff --git a/input/test/dpncnt.ly b/input/test/dpncnt.ly index 4af4c9ae34..b224175325 100644 --- a/input/test/dpncnt.ly +++ b/input/test/dpncnt.ly @@ -98,15 +98,9 @@ ch = \notes \transpose c c' % #(set-chord-name-style 'double-plus-new-banter) % #(set-chord-name-style 'double-plus-new-jazz) - #(set-double-plus-new-chord-name-style 'banter - `((separator . ,(make-simple-markup ":")) - (full-exceptions . ,efull) - (partial-exceptions . ,epartial))) + #(set-chord-name-style 'banter) \ch - #(set-double-plus-new-chord-name-style 'jazz - `((separator . ,(make-simple-markup ":")) - (full-exceptions . ,efull) - (partial-exceptions . ,epartial))) + #(set-chord-name-style 'jazz) \ch } diff --git a/ly/chord-modifiers-init.ly b/ly/chord-modifiers-init.ly index 2f023d21e0..e941550a5b 100644 --- a/ly/chord-modifiers-init.ly +++ b/ly/chord-modifiers-init.ly @@ -18,3 +18,22 @@ ignatzekExceptionMusic = \notes{ ignatzekExceptions = #(sequential-music-to-chord-exceptions ignatzekExceptionMusic #t) +partialJazzMusic = \notes{ + <>1-\markup { \normal-size-super "2" } + <>-\markup { "m" } + <>-\markup { \normal-size-super "sus4" } + <>-\markup { \normal-size-super "5" } + + %% TODO, partial exceptions + <>-\markup { "m" }-\markup { \normal-size-super "sus4" } + <>-\markup { "m" }-\markup { \normal-size-super "sus2" } +} + +%% TODO: compatibility ignatzek code +fullJazzExceptions = #(sequential-music-to-chord-exceptions + ignatzekExceptionMusic #f) + +partialJazzExceptions = #(sequential-music-to-chord-exceptions + partialJazzMusic #f) + + \ No newline at end of file diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index 9d919c0e2b..bf82304533 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -496,6 +496,9 @@ ScoreContext = \translator { chordNameExceptions = #ignatzekExceptions chordNoteNamer = #'() chordRootNamer = #note-name->markup + + chordNameExceptionsFull = #fullJazzExceptions + chordNameExceptionsPartial = #partialJazzExceptions %% tablature: stringOneTopmost = ##t diff --git a/scm/chord-name.scm b/scm/chord-name.scm index 1160c0f9f1..ca25f36cf4 100644 --- a/scm/chord-name.scm +++ b/scm/chord-name.scm @@ -103,7 +103,9 @@ FOOBAR-MARKUP) if OMIT-ROOT. (lambda (y) (memq 'text-script-event (ly:get-mus-property y 'types))) elts))) - (text (if (null? texts) #f (car texts)))) + ;;(text (if (null? texts) #f (if (= length texts) 1) + ;; (car texts) (reverse texts)))) + (text (if (null? texts) #f (if omit-root (car texts) texts)))) (cons (if omit-root (cdr normalized) normalized) text))) (define (is-req-chord? m) @@ -143,49 +145,15 @@ FOOBAR-MARKUP) if OMIT-ROOT. "Return music expressions that set the chord naming style. For inline use in .ly file" - (define (chord-name-style-setter function exceptions) + (define (chord-name-style-setter function style) (context-spec-music (make-sequential-music (list (make-property-set 'chordNameFunction function) - (make-property-set 'chordNameExceptions exceptions))) - "ChordNames" - ) - ) - - (ly:export - (case sym - ((ignatzek) - (chord-name-style-setter ignatzek-chord-names - '())) - ((banter) - (chord-name-style-setter double-plus-new-chord->markup-banter - chord::exception-alist-banter)) - - ((jazz) - (chord-name-style-setter double-plus-new-chord->markup-jazz - chord::exception-alist-jazz)) - ))) - -;; can't put this in double-plus-new-chord-name.scm, because we can't -;; ly:load that very easily. -(define-public (set-double-plus-new-chord-name-style style options) - "Return music expressions that set the chord naming style. For -inline use in .ly file" - - (define (chord-name-style-setter function) - (context-spec-music - (make-sequential-music - (list (make-property-set 'chordNameFunction function) - - ;; urg , misuse of chordNameExceptions function. - (make-property-set 'chordNameExceptions options))) + (make-property-set 'chordNameStyle style))) "ChordNames")) (ly:export - (case style - ((banter) - (chord-name-style-setter double-plus-new-chord->markup-banter)) - - ((jazz) - (chord-name-style-setter double-plus-new-chord->markup-jazz))))) - + (case sym + ((ignatzek) (chord-name-style-setter ignatzek-chord-names)) + ((banter) (chord-name-style-setter double-plus-new-chord->markup 'banter)) + ((jazz) (chord-name-style-setter double-plus-new-chord->markup 'jazz))))) diff --git a/scm/define-translator-properties.scm b/scm/define-translator-properties.scm index 1d0818c81e..5384fcf21b 100644 --- a/scm/define-translator-properties.scm +++ b/scm/define-translator-properties.scm @@ -156,6 +156,9 @@ into one staff.") (translator-property-description 'chordNameFunction procedure? "The function that converts lists of pitches to chord names.") +(translator-property-description + 'chordNameStyle symbol? + "The chord name style: ignatzek, banter or jazz.") (translator-property-description 'chordNoteNamer procedure? "Function that converts from a pitch object to a text markup. Used for single pitches.") @@ -165,6 +168,12 @@ into one staff.") (translator-property-description 'chordNameExceptions list? "Alist of chord exceptions. Contains (CHORD . MARKUP) entries.") +(translator-property-description + 'chordNameExceptionsFull list? + "Alist of chord exceptions. Contains (CHORD . (MARKUP)) entries.") +(translator-property-description + 'chordNameExceptionsPartial list? + "Alist of partial chord exceptions. Contains (CHORD . (PREFIX-MARKUP SUFFIX-MARKUP)) entries.") (translator-property-description 'chordNameSeparator markup? "The markup object used to separate parts of a chord name.") diff --git a/scm/double-plus-new-chord-name.scm b/scm/double-plus-new-chord-name.scm index 0ae5af29c5..e495bdcd2a 100644 --- a/scm/double-plus-new-chord-name.scm +++ b/scm/double-plus-new-chord-name.scm @@ -22,24 +22,25 @@ markup)) markup)) -(define-public (double-plus-new-chord->markup-banter . args) - (apply double-plus-new-chord->markup (cons 'banter args))) +(define-public (double-plus-new-chord->markup + pitches bass inversion context) + (let ((options '()) + (style (ly:get-context-property context 'chordNameStyle))) + (ugh-compat-double-plus-new-chord->markup + style pitches bass inversion context options))) -(define-public (double-plus-new-chord->markup-jazz . args) - (apply double-plus-new-chord->markup (cons 'jazz args))) +(define-public (ugh-compat-double-plus-new-chord->markup + style pitches bass inversion context options) + "Entry point for New_chord_name_engraver. -;; FIXME: if/when double-plus-new-chord->markup get installed -;; setting and calling can be done a bit handier. -(define-public (double-plus-new-chord->markup - func pitches bass inversion - context) - "Entry point for New_chord_name_engraver. See -double-plus-new-chord-name.scm for the signature of FUNC. PITCHES, +FIXME: func, options/context have changed + See +double-plus-new-chord-name.scm for the signature of STYLE. PITCHES, BASS and INVERSION are lily pitches. OPTIONS is an alist-alist (see input/test/dpncnt.ly). " - (define options (ly:get-context-property context 'chordNameExceptions)) - + + (define (step-nr pitch) (let* ((pitch-nr (+ (* 7 (ly:pitch-octave pitch)) (ly:pitch-notename pitch))) @@ -86,10 +87,17 @@ input/test/dpncnt.ly). (define (step->markup-accidental pitch) (make-line-markup - (list - (accidental->markup (step-alteration pitch)) - (make-simple-markup (number->string (step-nr pitch)))))) + (list (accidental->markup (step-alteration pitch)) + (make-simple-markup (number->string (step-nr pitch)))))) + (define (step->markup-ignatzek pitch) + (make-line-markup + (if (and (= (step-nr pitch) 7) + (= (step-alteration pitch) 1)) + (list (ly:get-context-property context 'majorSevenSymbol)) + (list (accidental->markup (step-alteration pitch)) + (make-simple-markup (number->string (step-nr pitch))))))) + ;; tja, kennok (define (make-sub->markup step->markup) (lambda (pitch) @@ -120,7 +128,7 @@ input/test/dpncnt.ly). (if (equal? e-pitches pitches) e (full-match (cdr exceptions)))) - '(()))) + #f)) (define (partial-match exceptions) (if (pair? exceptions) @@ -129,20 +137,24 @@ input/test/dpncnt.ly). (if (equal? e-pitches (first-n (length e-pitches) pitches)) e (partial-match (cdr exceptions)))) - '(()))) + #f)) (if #f (begin - (write-me "options: " options) (write-me "pitches: " pitches))) - (let* ((full-exceptions (assoc-get 'full-exceptions options)) + (let* ((full-exceptions + (ly:get-context-property context 'chordNameExceptionsFull)) (full-exception (full-match full-exceptions)) - (full-markup (cdr full-exception)) - - (partial-exceptions (assoc-get 'partial-exceptions options)) + (full-markup (if full-exception (cadr full-exception) '())) + (partial-exceptions + (ly:get-context-property context 'chordNameExceptionsPartial)) (partial-exception (partial-match partial-exceptions)) - (partial-pitches (car partial-exception)) - (partial-markup (markup-or-empty-markup (cdr partial-exception))) - + (partial-pitches (if partial-exception (car partial-exception) '())) + (partial-markup-prefix + (if partial-exception (markup-or-empty-markup + (cadr partial-exception)) empty-markup)) + (partial-markup-suffix + (if (and partial-exception (pair? (cddr partial-exception))) + (markup-or-empty-markup (caddr partial-exception)) empty-markup)) (root (car pitches)) (full (get-full-list root)) ;; kludge alert: replace partial matched lower part of all with @@ -160,11 +172,12 @@ input/test/dpncnt.ly). (base (list-minus consecutive altered))) - (if #f (begin - (write-me "full:" full) + (if #f (begin + (write-me "full:" full) ;; (write-me "partial-pitches:" partial-pitches) (write-me "full-markup:" full-markup) - (write-me "partial-markup:" partial-markup) + (write-me "partial-markup-perfix:" partial-markup-prefix) + (write-me "partial-markup-suffix:" partial-markup-suffix) (write-me "all:" all) (write-me "altered:" altered) (write-me "missing:" missing) @@ -172,7 +185,7 @@ input/test/dpncnt.ly). (write-me "rest:" rest) (write-me "base:" base))) - (case func + (case style ((banter) ;; root ;; + steps:altered + (highest all -- if not altered) @@ -196,7 +209,7 @@ input/test/dpncnt.ly). (make-line-markup (list (root->markup root) - partial-markup + partial-markup-prefix (make-normal-size-super-markup (markup-join (apply append @@ -206,7 +219,7 @@ input/test/dpncnt.ly). (not (step-even-or-altered? highest))) (list highest) '()))) - + (list partial-markup-suffix) (list (map sub->markup missing))) sep))))))) @@ -218,8 +231,11 @@ input/test/dpncnt.ly). ;; + steps:rest (let* ((root->markup (assoc-get-default 'root->markup options note-name->markup)) - (step->markup (assoc-get-default - 'step->markup options step->markup-accidental)) + (step->markup + (assoc-get-default + ;; FIXME: ignatzek + ;;'step->markup options step->markup-accidental)) + 'step->markup options step->markup-ignatzek)) (sep (assoc-get-default 'separator options (make-simple-markup " "))) (add-prefix (assoc-get-default 'add-prefix options @@ -232,7 +248,7 @@ input/test/dpncnt.ly). (make-line-markup (list (root->markup root) - partial-markup + partial-markup-prefix (make-normal-size-super-markup (make-line-markup (list @@ -256,8 +272,7 @@ input/test/dpncnt.ly). (if (pair? rest) add-prefix empty-markup) - (markup-join (map step->markup rest) sep))))))))) + (markup-join (map step->markup rest) sep) + partial-markup-suffix)))))))) (else empty-markup)))) - -