From 1393f1d173451806b150ec508ebc622b410c3b84 Mon Sep 17 00:00:00 2001 From: Henning Hraban Ramm Date: Sun, 21 Mar 2010 15:34:14 +0100 Subject: [PATCH] lowercase minor chord names patch --- ly/engraver-init.ly | 1 + scm/chord-ignatzek-names.scm | 23 ++++++++++------ scm/chord-name.scm | 46 +++++++++++++++++++------------ scm/define-context-properties.scm | 1 + 4 files changed, 46 insertions(+), 25 deletions(-) diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index 81b6c8861a..8b11f0a332 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -591,6 +591,7 @@ automatically when an output definition (a @code{\score} or %% chord names: chordNameFunction = #ignatzek-chord-names majorSevenSymbol = #whiteTriangleMarkup + chordNameLowercaseMinor = ##f chordNameSeparator = #(make-simple-markup "/") chordNameExceptions = #ignatzekExceptions chordNoteNamer = #'() diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm index 7c08140e8e..161288a3de 100644 --- a/scm/chord-ignatzek-names.scm +++ b/scm/chord-ignatzek-names.scm @@ -99,7 +99,8 @@ alteration-pitches addition-pitches suffix-modifiers - bass-pitch) + bass-pitch + lowercase-root?) "Format for the given (lists of) pitches. This is actually more work than classifying the pitches." @@ -129,7 +130,7 @@ work than classifying the pitches." (define (prefix-modifier->markup mod) (if (and (= 3 (pitch-step mod)) (= FLAT (ly:pitch-alteration mod))) - (make-simple-markup "m") + (make-simple-markup (if lowercase-root? "" "m")) (make-simple-markup "huh"))) (define (filter-alterations alters) @@ -167,7 +168,7 @@ work than classifying the pitches." (make-line-markup total))) (let* ((sep (ly:context-property context 'chordNameSeparator)) - (root-markup (name-root root)) + (root-markup (name-root root lowercase-root?)) (add-markups (map (lambda (x) (glue-word-to-step "add" x)) addition-pitches)) (filtered-alterations (filter-alterations alteration-pitches)) @@ -199,20 +200,25 @@ work than classifying the pitches." (define (ignatzek-format-exception root exception-markup - bass-pitch) + bass-pitch + lowercase-root?) (make-line-markup `( - ,(name-root root) + ,(name-root root lowercase-root?) ,exception-markup . ,(if (ly:pitch? bass-pitch) (list (ly:context-property context 'chordNameSeparator) - (name-note bass-pitch)) + (name-note bass-pitch #f)) '())))) (let* ((root (car in-pitches)) (pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches))) + (lowercase-root? + (and (ly:context-property context 'chordNameLowercaseMinor) + (let ((third (get-step 3 pitches))) + (and third (= (ly:pitch-alteration third) FLAT))))) (exceptions (ly:context-property context 'chordNameExceptions)) (exception (assoc-get pitches exceptions)) (prefixes '()) @@ -226,7 +232,7 @@ work than classifying the pitches." (alterations '())) (if exception - (ignatzek-format-exception root exception bass-note) + (ignatzek-format-exception root exception bass-note lowercase-root?) (begin ;; no exception. @@ -281,4 +287,5 @@ work than classifying the pitches." (set! alterations '()))) (ignatzek-format-chord-name - root prefixes main-name alterations add-steps suffixes bass-note)))))) + root prefixes main-name alterations add-steps suffixes bass-note + lowercase-root?)))))) diff --git a/scm/chord-name.scm b/scm/chord-name.scm index 62871f896a..7f5909b3df 100644 --- a/scm/chord-name.scm +++ b/scm/chord-name.scm @@ -22,11 +22,16 @@ FLAT 0)) -;; +(define (conditional-string-downcase str condition) + (if condition + (string-downcase str) + str)) + +;; ;; TODO: make into markup. -;; +;; (define-public (alteration->text-accidental-markup alteration) - + (make-smaller-markup (make-raise-markup (if (= alteration FLAT) @@ -34,7 +39,7 @@ 0.6) (make-musicglyph-markup (assoc-get alteration standard-alteration-glyph-name-alist ""))))) - + (define (accidental->markup alteration) "Return accidental markup for ALTERATION." (if (= alteration 0) @@ -54,18 +59,21 @@ (make-hspace-markup (if (= alteration SHARP) 0.2 0.1)) )))) -(define-public (note-name->markup pitch) +(define-public (note-name->markup pitch lowercase?) "Return pitch markup for PITCH." (make-line-markup (list (make-simple-markup - (vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename pitch))) - (accidental->markup (ly:pitch-alteration pitch))))) + (conditional-string-downcase + (vector-ref #("C" "D" "E" "F" "G" "A" "B") (ly:pitch-notename pitch)) + lowercase?)) + (accidental->markup (ly:pitch-alteration pitch))))) (define (pitch-alteration-semitones pitch) (inexact->exact (round (* (ly:pitch-alteration pitch) 2)))) -(define-safe-public ((chord-name->german-markup B-instead-of-Bb) pitch) +(define-safe-public ((chord-name->german-markup B-instead-of-Bb) + pitch lowercase?) "Return pitch markup for PITCH, using german note names. If B-instead-of-Bb is set to #t real german names are returned. Otherwise semi-german names (with Bb and below keeping the british names) @@ -78,11 +86,13 @@ (make-line-markup (list (make-simple-markup - (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))) + (conditional-string-downcase + (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a)) + lowercase?)) (make-normal-size-super-markup (accidental->markup (/ (cdr n-a) 2))))))) -(define-safe-public (note-name->german-markup pitch) +(define-safe-public (note-name->german-markup pitch lowercase?) (let* ((name (ly:pitch-notename pitch)) (alt-semitones (pitch-alteration-semitones pitch)) (n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2))) @@ -96,7 +106,7 @@ (list-ref '( "ses" "s" "" "is" "isis") (+ 2 (cdr n-a))) (list-ref '("eses" "es" "" "is" "isis") (+ 2 (cdr n-a))))))))) -(define-public ((chord-name->italian-markup re-with-eacute) pitch) +(define-public ((chord-name->italian-markup re-with-eacute) pitch lowercase?) "Return pitch markup for PITCH, using italian/french note names. If re-with-eacute is set to #t, french 'ré' is returned for D instead of 're' " @@ -105,11 +115,13 @@ (make-line-markup (list (make-simple-markup - (vector-ref - (if re-with-eacute - #("Do" "Ré" "Mi" "Fa" "Sol" "La" "Si") - #("Do" "Re" "Mi" "Fa" "Sol" "La" "Si")) - name)) + (conditional-string-downcase + (vector-ref + (if re-with-eacute + #("Do" "Ré" "Mi" "Fa" "Sol" "La" "Si") + #("Do" "Re" "Mi" "Fa" "Sol" "La" "Si")) + name) + lowercase?)) (accidental->markup-italian alt) )))) @@ -131,7 +143,7 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false. elts))) (sorted (sort pitches ly:pitch ..., diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm index 5f937f6a31..1da05b637a 100644 --- a/scm/define-context-properties.scm +++ b/scm/define-context-properties.scm @@ -146,6 +146,7 @@ exceptions. Contains @code{(@var{chord} . (@var{prefix-markup} @var{suffix-markup}))} entries.") (chordNameFunction ,procedure? "The function that converts lists of pitches to chord names.") + (chordNameLowercaseMinor ,boolean? "Downcase roots of minor chords?") (chordNameSeparator ,markup? "The markup object used to separate parts of a chord name.") (chordNoteNamer ,procedure? "A function that converts from a pitch -- 2.39.2