+2003-06-10 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * 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 <rune@zedeler.dk>
* ly/property-init.ly (germanChords): Added.
-\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-
- <<c es ges bes>>-\markup { \super " o" }
+chs = \notes \transpose c c'
+{
+ <<c e g>>1-"dpn"
+ <<c es g>>% m = minor triad
+ <<c e gis>>
+ <<c es ges>> \break
+ <<c e g bes>>
+ <<c es g bes>>
+ <<c e g b>> % triangle = maj
+ <<c es ges beses>>
+ <<c es ges b>> \break
+ <<c e gis bes>>
+ <<c es g b>>
+ <<c e gis b>>
+ <<c es ges bes>>\break
+ <<c e g a>> % 6 = major triad with added sixth
+ <<c es g a>> % m6 = minor triad with added sixth
+ <<c e g bes d'>>
+ <<c es g bes d'>> \break
+ <<c es g bes d' f' a' >>
+ <<c es g bes d' f' >>
+ <<c es ges bes d' >>
+ <<c e g bes des' >> \break
+ <<c e g bes dis'>>
+ <<c e g bes d' f'>>
+ <<c e g bes d' fis'>>
+ <<c e g bes d' f' a'>>\break
+ <<c e g bes d' fis' as'>>
+ <<c e gis bes dis'>>
+ <<c e g bes dis' fis'>>
+ <<c e g bes d' f' as'>>\break
+ <<c e g bes des' f' as'>>
+ <<c e g bes d' fis'>>
+ <<c e g b d'>>
+ <<c e g bes d' f' as'>>\break
+ <<c e g bes des' f' as'>>
+ <<c e g bes des' f' a'>>
+ <<c e g b d'>>
+ <<c e g b d' f' a'>>\break
+ <<c e g b d' fis'>>
+ <<c e g bes des' f ' a'>>
+ <<c f g>>
+ <<c f g bes>>\break
+ <<c f g bes d'>>
+ <<c e g d'>> % add9
+ <<c es g f'>>
+}
- %% Hmm, this ok?
- %% c:7+
+efullmusic = \notes{
+ <<c e gis>>1-\markup { "+" }
<<c e g b>>-\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" }
+
+ <<c es ges>>-\markup { \super "o" } % should be $\circ$ ?
+ <<c es ges bes>>-\markup { \super \combine "o" "/" }
+ <<c es ges beses>>-\markup { \super "o7" }
}
efull = #(sequential-music-to-chord-exceptions efullmusic #f)
-epartialmusic = \notes {
- %c:2^3 =
- <<c d>>-\markup { \normal-size-super "2" }
- %c:3-
+epartialmusic = \notes{
+ <<c d>>1-\markup { \normal-size-super "2" }
<<c es>>-\markup { "m" }
- %c:4
<<c f>>-\markup { \normal-size-super "sus4" }
- %c:5^3
<<c g>>-\markup { \normal-size-super "5" }
+
+ %% TODO, partial exceptions
+ <<c es f>>-\markup { "m" }-\markup { \normal-size-super "sus4" }
+ <<c d es>>-\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 %%
-
+
% #(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
}
ignatzekExceptions = #(sequential-music-to-chord-exceptions
ignatzekExceptionMusic #t)
+partialJazzMusic = \notes{
+ <<c d>>1-\markup { \normal-size-super "2" }
+ <<c es>>-\markup { "m" }
+ <<c f>>-\markup { \normal-size-super "sus4" }
+ <<c g>>-\markup { \normal-size-super "5" }
+
+ %% TODO, partial exceptions
+ <<c es f>>-\markup { "m" }-\markup { \normal-size-super "sus4" }
+ <<c d es>>-\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
chordNameExceptions = #ignatzekExceptions
chordNoteNamer = #'()
chordRootNamer = #note-name->markup
+
+ chordNameExceptionsFull = #fullJazzExceptions
+ chordNameExceptionsPartial = #partialJazzExceptions
%% tablature:
stringOneTopmost = ##t
(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)
"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)))))
(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.")
(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.")
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)))
(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)
(if (equal? e-pitches pitches)
e
(full-match (cdr exceptions))))
- '(())))
+ #f))
(define (partial-match exceptions)
(if (pair? exceptions)
(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
(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)
(write-me "rest:" rest)
(write-me "base:" base)))
- (case func
+ (case style
((banter)
;; root
;; + steps:altered + (highest all -- if not altered)
(make-line-markup
(list
(root->markup root)
- partial-markup
+ partial-markup-prefix
(make-normal-size-super-markup
(markup-join
(apply append
(not
(step-even-or-altered? highest)))
(list highest) '())))
-
+ (list partial-markup-suffix)
(list (map sub->markup missing)))
sep)))))))
;; + 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
(make-line-markup
(list
(root->markup root)
- partial-markup
+ partial-markup-prefix
(make-normal-size-super-markup
(make-line-markup
(list
(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))))
-
-
projects / lilypond.git / commitdiff