Fix 78: lowercase minor chord names patch

diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly
index 81b6c8861aa6cebab34d1d906ea1438722288843..8b11f0a3327e29061680d9db18e686b209f319e0 100644 (file)
--- 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
 %% chord names:
   chordNameFunction = #ignatzek-chord-names
   majorSevenSymbol = #whiteTriangleMarkup

+  chordNameLowercaseMinor = ##f

   chordNameSeparator = #(make-simple-markup  "/")
   chordNameExceptions = #ignatzekExceptions
   chordNoteNamer = #'()
   chordNameSeparator = #(make-simple-markup  "/")
   chordNameExceptions = #ignatzekExceptions
   chordNoteNamer = #'()

diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm
index 7c08140e8e481eb43c1cb499eeb168b8b348f5cd..161288a3deb7a96b6388b2403bbb2865f98c9622 100644 (file)
--- a/scm/chord-ignatzek-names.scm
+++ b/scm/chord-ignatzek-names.scm
@@ -99,7 +99,8 @@
           alteration-pitches
           addition-pitches
           suffix-modifiers
           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."
 
     "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)))
     (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)
          (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))
        (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))
           (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
   (define (ignatzek-format-exception
           root
           exception-markup

-          bass-pitch)
+          bass-pitch
+          lowercase-root?)

 
     (make-line-markup
      `(
 
     (make-line-markup
      `(

-       ,(name-root root)
+       ,(name-root root lowercase-root?)

        ,exception-markup
        . 
        ,(if (ly:pitch? bass-pitch)
            (list (ly:context-property context 'chordNameSeparator)
        ,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)))
            '()))))
 
   (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 '())
         (exceptions (ly:context-property context 'chordNameExceptions))
         (exception (assoc-get pitches exceptions))
         (prefixes '())


@@ -226,7 +232,7 @@ work than classifying the pitches."
         (alterations '()))
     
     (if exception
         (alterations '()))
     
     (if exception

-       (ignatzek-format-exception root exception bass-note)
+       (ignatzek-format-exception root exception bass-note lowercase-root?)

        
        (begin
          ;; no exception.
        
        (begin
          ;; no exception.


@@ -281,4 +287,5 @@ work than classifying the pitches."
                  (set! alterations '())))
 
            (ignatzek-format-chord-name
                  (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 62871f896a053d31918129d6bbf9c5ddc7701a96..7f5909b3dfdf7668c03e182ebefae0ae4c898d4a 100644 (file)
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -22,11 +22,16 @@
       FLAT
       0))
 
       FLAT
       0))
 

-;; 
+(define (conditional-string-downcase str condition)
+  (if condition
+      (string-downcase str)
+      str))
+
+;;

 ;; TODO: make into markup.
 ;; TODO: make into markup.

-;; 
+;;

 (define-public (alteration->text-accidental-markup alteration)
 (define-public (alteration->text-accidental-markup alteration)

-  
+

   (make-smaller-markup
    (make-raise-markup
     (if (= alteration FLAT)
   (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 "")))))
        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)
 (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))
        ))))
 
        (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
   "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 (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)
   "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
     (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)))))))
 
       (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)))
   (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)))))))))
 
           (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'
 "
   "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
     (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)
       ))))
 
       (accidental->markup-italian alt)
       ))))
 


@@ -131,7 +143,7 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
                          elts)))
           (sorted (sort pitches ly:pitch<?))
           (root (car sorted))
                          elts)))
           (sorted (sort pitches ly:pitch<?))
           (root (car sorted))

-          
+

           ;; ugh?
           ;;(diff (ly:pitch-diff root (ly:make-pitch -1 0 0)))
           ;; FIXME.  This results in #<Pitch c> ...,
           ;; ugh?
           ;;(diff (ly:pitch-diff root (ly:make-pitch -1 0 0)))
           ;; FIXME.  This results in #<Pitch c> ...,

diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm
index 5f937f6a31170607599e78f928df621f94381112..1da05b637a1e2f5c8215ac2deb21235d9bccb47c 100644 (file)
--- 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.")
 @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
      (chordNameSeparator ,markup? "The markup object used to
 separate parts of a chord name.")
      (chordNoteNamer ,procedure? "A function that converts from a pitch