Doc-de: updates to notation manual

[lilypond.git] / scm / chord-ignatzek-names.scm

diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm
index 0621716d17e7c12094b8c64140e0dd2845fb7526..e1d51a85e0ec81a5f7252591223e7803f544c957 100644 (file)
--- a/scm/chord-ignatzek-names.scm
+++ b/scm/chord-ignatzek-names.scm
@@ -1,8 +1,19 @@
-;;;; chord-ignatzek-names.scm --  chord name utility functions
+;;;; This file is part of LilyPond, the GNU music typesetter.

 ;;;;
 ;;;;

-;;;; source file of the GNU LilyPond music typesetter
-;;;; 
-;;;; (c) 2000--2009  Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2000--2011  Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.

 
 
 
 
 
 


@@ -12,14 +23,14 @@
 ;; jazz-part 2
 ;;
 ;; after Klaus Ignatzek,   Die Jazzmethode fuer Klavier 1.
 ;; jazz-part 2
 ;;
 ;; after Klaus Ignatzek,   Die Jazzmethode fuer Klavier 1.

-;; 
+;;

 ;; The idea is: split chords into
 ;; The idea is: split chords into

-;;  
+;;

 ;;  ROOT PREFIXES MAIN-NAME ALTERATIONS SUFFIXES ADDITIONS
 ;;
 ;; and put that through a layout routine.
 ;;  ROOT PREFIXES MAIN-NAME ALTERATIONS SUFFIXES ADDITIONS
 ;;
 ;; and put that through a layout routine.

-;; 
-;; the split is a procedural process, with lots of set!. 
+;;
+;; the split is a procedural process, with lots of set!.

 ;;
 
 
 ;;
 
 


@@ -33,7 +44,7 @@
   (if (null? ps)
       #f
       (if (= (- x 1) (ly:pitch-steps (car ps)))
   (if (null? ps)
       #f
       (if (= (- x 1) (ly:pitch-steps (car ps)))

-         (car ps) 
+         (car ps)

          (get-step x (cdr ps)))))
 
 (define (replace-step p ps)
          (get-step x (cdr ps)))))
 
 (define (replace-step p ps)


@@ -66,21 +77,21 @@
        (if (< (ly:pitch-steps (car ps)) (- x 1))
            (remove-uptil-step x (cdr ps))
            ps)))
        (if (< (ly:pitch-steps (car ps)) (- x 1))
            (remove-uptil-step x (cdr ps))
            ps)))

-  
+

   (define name-root (ly:context-property context 'chordRootNamer))
   (define name-root (ly:context-property context 'chordRootNamer))

-  (define name-note 
+  (define name-note

     (let ((nn (ly:context-property context 'chordNoteNamer)))
       (if (eq? nn '())
          ;; replacing the next line with name-root gives guile-error...? -rz
 
          ;; apparently sequence of defines is equivalent to let, not let* ? -hwn
     (let ((nn (ly:context-property context 'chordNoteNamer)))
       (if (eq? nn '())
          ;; replacing the next line with name-root gives guile-error...? -rz
 
          ;; apparently sequence of defines is equivalent to let, not let* ? -hwn

-         (ly:context-property context 'chordRootNamer)   
+         (ly:context-property context 'chordRootNamer)

          ;; name-root
          nn)))
 
   (define (is-natural-alteration? p)
     (= (natural-chord-alteration p) (ly:pitch-alteration p)))
          ;; name-root
          nn)))
 
   (define (is-natural-alteration? p)
     (= (natural-chord-alteration p) (ly:pitch-alteration p)))

-  
+

   (define (ignatzek-format-chord-name
           root
           prefix-modifiers
   (define (ignatzek-format-chord-name
           root
           prefix-modifiers


@@ -88,11 +99,12 @@
           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."

-    
+

     (define (filter-main-name p)
       "The main name: don't print anything for natural 5 or 3."
       (if
     (define (filter-main-name p)
       "The main name: don't print anything for natural 5 or 3."
       (if


@@ -104,29 +116,29 @@ work than classifying the pitches."
        (list (name-step p))))
 
     (define (glue-word-to-step word x)
        (list (name-step p))))
 
     (define (glue-word-to-step word x)

-      (make-line-markup 
+      (make-line-markup

        (list
        (make-simple-markup word)
        (name-step x))))
        (list
        (make-simple-markup word)
        (name-step x))))

-    
+

     (define (suffix-modifier->markup mod)
       (if (or (= 4 (pitch-step mod))
              (= 2 (pitch-step mod)))
          (glue-word-to-step "sus" mod)
          (glue-word-to-step "huh" mod)))
     (define (suffix-modifier->markup mod)
       (if (or (= 4 (pitch-step mod))
              (= 2 (pitch-step mod)))
          (glue-word-to-step "sus" mod)
          (glue-word-to-step "huh" mod)))

-    
+

     (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")))
          (make-simple-markup "huh")))

-    
+

     (define (filter-alterations alters)
       "Filter out uninteresting (natural) pitches from ALTERS."
     (define (filter-alterations alters)
       "Filter out uninteresting (natural) pitches from ALTERS."

-      
+

       (define (altered? p)
        (not (is-natural-alteration? p)))
       (define (altered? p)
        (not (is-natural-alteration? p)))

-      
+

       (if
        (null? alters)
        '()
       (if
        (null? alters)
        '()


@@ -152,11 +164,11 @@ work than classifying the pitches."
                            (list (ly:context-property context 'majorSevenSymbol))
                            args)
                        (cons (accidental->markup (step-alteration pitch)) args))))
                            (list (ly:context-property context 'majorSevenSymbol))
                            args)
                        (cons (accidental->markup (step-alteration pitch)) args))))

-       
+

        (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))


@@ -171,7 +183,7 @@ work than classifying the pitches."
                                 suffixes
                                 add-markups) sep))
           (base-stuff (if (ly:pitch? bass-pitch)
                                 suffixes
                                 add-markups) sep))
           (base-stuff (if (ly:pitch? bass-pitch)

-                          (list sep (name-note bass-pitch))
+                          (list sep (name-note bass-pitch #f))

                           '())))
 
       (set! base-stuff
                           '())))
 
       (set! base-stuff


@@ -188,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
        ,exception-markup

-       . 
+       .

        ,(if (ly:pitch? bass-pitch)
            (list (ly:context-property context 'chordNameSeparator)
        ,(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 '())


@@ -213,10 +230,10 @@ work than classifying the pitches."
              inversion
              bass))
         (alterations '()))
              inversion
              bass))
         (alterations '()))

-    
+

     (if exception
     (if exception

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

        (begin
          ;; no exception.
          ;; handle sus4 and sus2 suffix: if there is a 3 together with
        (begin
          ;; no exception.
          ;; handle sus4 and sus2 suffix: if there is a 3 together with


@@ -236,7 +253,7 @@ work than classifying the pitches."
          (if (and (get-step 3 pitches)
                   (= (ly:pitch-alteration (get-step 3 pitches)) FLAT))
              (set! prefixes (cons (get-step 3 pitches) prefixes)))
          (if (and (get-step 3 pitches)
                   (= (ly:pitch-alteration (get-step 3 pitches)) FLAT))
              (set! prefixes (cons (get-step 3 pitches) prefixes)))

-         
+

          ;; lazy bum. Should write loop.
          (cond
           ((get-step 7 pitches) (set! main-name (get-step 7 pitches)))
          ;; lazy bum. Should write loop.
          (cond
           ((get-step 7 pitches) (set! main-name (get-step 7 pitches)))


@@ -270,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?))))))