* lily/include/file-results.hh (class Input_file_settings):

[lilypond.git] / scm / chord-name.scm

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 1e409e4bc7d39a3dbe47302e38d9d6213ae0a6e0..c47b803a284e3e3b05636ae5a9e322f41068eb8c 100644 (file)
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -47,16 +47,20 @@
        ; Cm iso Cm.no5
        (((0 . 0) (2 . -1)) . ("m"))
        ; C2 iso C2.no3
-       (((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2")))
+       (((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2") " "))
        ; C4 iso C4.no3
-       (((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4")))
+       (((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4") " " ))
        ;; Cdim iso Cm5-
        (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
-       ; Co iso Cm5-7-
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o")))
+       ; URG: Simply C:m5-/maj7 iso Cdim maj7
+       (((0 . 0) (2 . -1) (4 . -1) (6 . 0)) . ("m" (super "5-/maj7" " ")))
+       ; URG: Simply C:m5-/7 iso Cdim7
+       (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . ("m" (super "5-/7" " ")))
+       ; Co iso C:m5-/7-
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") " "))
        ; Cdim9
-       (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9")))
-       (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11")))
+       (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1)) . ("dim" (super "9") " "))
+       (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1)) . ("dim" (super "11") " "))
        )
       chord::names-alist-banter))
 
@@ -64,7 +68,7 @@
 (define simple-super
 ;; duh, no docstrings for 
 ;;  "No real superscript, just raised and small"
-  '((raise . 1) (font-relative-size . -1)))
+  '((raise . 1) (font-relative-size . -2)))
 
 (define (accidental->textp acc pos)
   (if (= acc 0)
@@ -73,8 +77,7 @@
                   (list pos (string-append "accidentals-" (number->string acc))))))
 
 (define (accidental->text acc) (accidental->textp acc 'columns))
-(define (accidental->text-super acc)
-  (accidental->textp acc '((raise . 0.6) (font-relative-size . -1))))
+(define (accidental->text-super acc) (accidental->textp acc 'simple-super))
 (define (accidental->text-sub acc) (accidental->textp acc 'sub))
 
 (define (pitch->note-name pitch)
@@ -158,6 +161,7 @@
 (define (chord::text? text)
   (not (or (not text) (empty? text) (unspecified? text))))
 
+;; FIXME: remove need for me, use text-append throughout
 (define (chord::text-cleanup dirty)
   "
    Recursively remove '() #f, and #<unspecified> from markup text tree.
@@ -309,28 +313,21 @@
 ;; additions, subtractions and bass or inversion into chord name
 (define (chord::inner-name-banter tonic exception-part additions subtractions
                                  bass-and-inversion steps)
-  (let ((tonic-text (pitch->chord-name-text-banter tonic steps))
-       (except-text exception-part)
-       (sep-text (if (and (string-match "super" (format "~s" exception-part))
+  (let* ((tonic-text (pitch->chord-name-text-banter tonic steps))
+        (except-text exception-part)
+        (sep-text (if (and (string-match "super" (format "~s" except-text))
                            (or (pair? additions)
                                (pair? subtractions)))
                       (list simple-super "/")))
-       (adds-text (chord::additions->text-banter additions subtractions))
-       (subs-text (chord::subtractions->text-banter subtractions))
-       (b+i-text (chord::bass-and-inversion->text-banter bass-and-inversion)))
+        (adds-text (chord::additions->text-banter additions subtractions))
+        (subs-text (chord::subtractions->text-banter subtractions))
+        (b+i-text (chord::bass-and-inversion->text-banter bass-and-inversion)))
     (text-append
-     tonic-text except-text sep-text
-     (list (list simple-super) adds-text subs-text)
+     tonic-text except-text " " sep-text
+     ;;(list (list simple-super) adds-text subs-text)
+     (list (list '((raise . 1) (font-relative-size . -1))) adds-text subs-text)
      b+i-text)))
 
-(define (chord::name-banter tonic exception-part unmatched-steps
-                           bass-and-inversion steps)
-  (let ((additions (chord::additions unmatched-steps))
-       (subtractions (chord::subtractions unmatched-steps)))
-    (chord::inner-name-banter tonic exception-part additions subtractions
-                             bass-and-inversion steps)))
-
-
 (define (c++-pitch->scm p)
   (if (pitch? p)
       (list (pitch-octave p) (pitch-notename p) (pitch-alteration p))
@@ -338,13 +335,14 @@
 
 (define (chord::name-banter tonic exception-part unmatched-steps
                            bass-and-inversion steps)
-  (let ((additions (chord::additions unmatched-steps))
-       (subtractions (chord::subtractions unmatched-steps)))
-    (chord::inner-name-banter tonic exception-part additions subtractions
-                             bass-and-inversion steps)))
+   (let ((additions (chord::additions unmatched-steps))
+        (subtractions (chord::subtractions unmatched-steps)))
+     (chord::inner-name-banter tonic exception-part additions subtractions
+                              bass-and-inversion steps)))
+
 
 (define (chord::restyle name style)
-  (ly-eval (string->symbol
+  (primitive-eval (string->symbol
            (string-append (symbol->string name)
                           (symbol->string style)))))
 
@@ -398,8 +396,9 @@
   (let* ((lookup (chord::exceptions-lookup style steps))
         (exception-part (car lookup))
         (unmatched-steps (cadr lookup)))
-    ((chord::restyle 'chord::name- style)
-     tonic exception-part unmatched-steps bass-and-inversion steps)))
+    (chord::text-cleanup
+     ((chord::restyle 'chord::name- style)
+      tonic exception-part unmatched-steps bass-and-inversion steps))))
 
 ;; C++ entry point
 ;; 
@@ -457,7 +456,7 @@
 ;Alternate:     (((0 . 0) (2 . 0) (4 . 1)) . ("+"))
         (((0 . 0) (1 . 0) (4 . 0)) . ("2"))
         ;; Common seventh chords
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") "7"))
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") " " "7"))
         (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) . ("maj7"))
         ;; urg! should use (0 . 0 2 . -1) -> "m", and add "7" to that!!
         (((0 . 0) (2 . -1) (4 . 0) (6 . -1)) . ("m7"))
@@ -466,7 +465,7 @@
         ;jazz: the delta, see jazz-chords.ly
         ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) .  (super ((font-family . math) "N"))
         ;; slashed o
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (columns (super (overstrike "o") "/") "7"))
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (columns (super (overstrike "o") "/") " " "7"))
 
         (((0 . 0) (2 . 0) (4 . 1) (6 . -1)) . ("aug7"))
         (((0 . 0) (2 . 0) (4 . -1) (6 . 0)) . (columns "maj7" ((font-relative-size . -2) ((raise . 0.2) (music (named "accidentals--1")))) "5"))
@@ -626,7 +625,7 @@
        ;; half diminshed chords
        ;; half diminished seventh chord = slashed o
        ;; (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (((raise . 0.8) "/o")))
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (columns (super (overstrike "o") "/") "7")) ; slashed o
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (columns (super (overstrike "o") "/") " " "7")) ; slashed o
 
        ; half diminished seventh chord  with major 9 = slashed o cancelation 9
        (((0 . 0) (2 . -1) (4 . -1) (6 . -1) (1 . 0)) . (
@@ -828,6 +827,16 @@ If we encounter a chromatically altered step, turn on list-step
       (append
       '(
         (((0 . 0) (2 . -1)) . ("m"))
+
+       ;; some fixups -- jcn
+       ; major seventh chord = triangle
+       (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "N"))))
+       ;; (((0 . 0) (2 . 0) (4 . 0) (6 . 0)) .  (((raise . 0.5)((font-family . math) "M"))))
+
+       ;; minor major seventh chord = m triangle
+       (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (columns ("m") ((raise . 0.5)((font-family . math) "N"))))
+       ;; (((0 . 0) (2 . -1) (4 . 0) (6 . 0)) . (columns ("m") ((raise . 0.5)((font-family . math) "M"))))
+       
        )
-      '()))
-      ;;chord::names-alist-american))
+      ;; '()))
+      chord::names-alist-american))