* scm/chord-name.scm: Super/raise changes and fixes for Banter.

* scm/new-markup.scm (normal-size-sub-markup)
(normal-size-super-markup): New function.

diff --git a/ChangeLog b/ChangeLog
index 426b3770211f9f6cef34285bcaad6a54de6b2bc1..11ac932a303e6aa219ccfb3b408ec4dc96d41511 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 2003-01-04  Jan Nieuwenhuizen  <janneke@gnu.org>
 
+       * scm/chord-name.scm: Super/raise changes and fixes for Banter.
+
+       * scm/new-markup.scm (normal-size-sub-markup) 
+       (normal-size-super-markup): New function.
+
        * lily/source-file.cc (Source_file): Add warning for possibly
        intentional but suspicious initialization.
 

diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly
index 0ed7f41b046082ac8d8836cdad5ff7af1af4652a..c8a1216fed79eee1f297168c0359835133ee878b 100644 (file)
--- a/ly/engraver-init.ly
+++ b/ly/engraver-init.ly
@@ -443,7 +443,7 @@ ScoreContext = \translator {
        )
        barCheckSynchronize = ##t
        chordNameFunction = #chord->markup-banter
-       chordNameExceptions = #chord::names-alist-banter
+       chordNameExceptions = #chord::exception-alist-banter
 
        \grobdescriptions #all-grob-descriptions
 }

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index b178a7a8ee19885357aa44075e1879ac1eb6617e..bcd39fd14f6c1f00c7d7c8c392d936f62ccfcc9b 100644 (file)
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -66,7 +66,7 @@ dump reinterpret the markup as a molecule.
 ;; markup = markup text -- see font.scm and input/test/markup.ly
 
 
-(define-public chord::names-alist-banter
+(define-public chord::exception-alist-banter
        `(
        ; C iso C.no3.no5
        (((0 . 0)) . ,empty-markup)
@@ -76,10 +76,10 @@ dump reinterpret the markup as a molecule.
        (((0 . 0) (2 . -1)) . ,(make-simple-markup "m"))
        ; C2 iso C2.no3
        (((0 . 0) (1 . 0) (4 . 0))
-        . ,(make-super-markup (make-simple-markup "2 ")))
+        . ,(make-normal-size-super-markup (make-simple-markup "2 ")))
        ; C4 iso C4.no3
        (((0 . 0) (3 . 0) (4 . 0))
-        . ,(make-super-markup (make-simple-markup "4 ")))
+        . ,(make-normal-size-super-markup (make-simple-markup "4 ")))
        ;; Cdim iso Cm5-
        (((0 . 0) (2 . -1) (4 . -1)) . ,(make-simple-markup "dim"))
        ; URG: Simply C:m5-/maj7 iso Cdim maj7
@@ -87,25 +87,25 @@ dump reinterpret the markup as a molecule.
         . ,(make-line-markup
             (list
              (make-simple-markup "m")
-             (make-super-markup (make-simple-markup "5-/maj7 ")))))
+             (make-normal-size-super-markup (make-simple-markup "5-/maj7 ")))))
        ; URG: Simply C:m5-/7 iso Cdim7
        (((0 . 0) (2 . -1) (4 . -1) (6 . -1))
         . ,(make-line-markup
             (list
              (make-simple-markup "m")
-             (make-super-markup (make-simple-markup "5-/7 ")))))
+             (make-normal-size-super-markup (make-simple-markup "5-/7 ")))))
        ; Co iso C:m5-/7-
         (((0 . 0) (2 . -1) (4 . -1) (6 . -2))
-        . ,(make-super-markup (make-simple-markup "o ")))
+        . ,(make-super-markup (make-simple-markup "o")))
        ; Cdim9
        (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1))
         . ,(make-line-markup
             (list (make-simple-markup "dim")
-                  (make-super-markup (make-simple-markup "9 ")))))
+                  (make-normal-size-super-markup (make-simple-markup "9 ")))))
        (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1))
         . ,(make-line-markup
             (list (make-simple-markup "dim")
-                               (make-super-markup
+                               (make-normal-size-super-markup
                                 (make-simple-markup "11 ")))))
        
        ))
@@ -157,9 +157,7 @@ dump reinterpret the markup as a molecule.
    (list
     (make-simple-markup
      (vector-ref #("C" "D" "E" "F" "G" "A" "B")  (cadr pitch)))
-    ;; undefined?
-    ;; (make-normal-size-superscript-markup
-    (make-super-markup
+    (make-normal-size-super-markup
      (accidental->markup (caddr pitch))))))
   
 ;;; Hooks to override chord names and note names, 
@@ -195,6 +193,34 @@ dump reinterpret the markup as a molecule.
         ((2)  "7+"))
        (step->markup pitch))))
 
+(define (step->markup-previously-alternate-jazz pitch)
+  (make-line-markup
+   (list
+    (accidental->markup (caddr pitch))
+    (make-simple-markup
+     (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))))))
+
+(define (step->markup-previously-jazz pitch)
+  (if (= (cadr pitch) 6)
+      (case (caddr pitch)
+       ;; sharp 7 only included for completeness?
+       ((-2) (make-line-markup
+              (list
+               (accidental->markup  -1)
+               (make-simple-markup "7"))))
+       ((-1) (make-simple-markup "7"))
+       ((0) (make-simple-markup "maj7"))
+       ;;((0) (make-line-markup
+       ;;      (list (make-simple-markup "maj7"))))
+       ((1) (make-line-markup
+             (list
+              (accidental->markup 1) (make-simple-markup "7"))))
+       ((2) (make-line-markup
+             (list (accidental->markup 1)
+                   (make-simple-markup "7")))))
+      (step->markup-previously-alternate-jazz pitch)))
+
+
 (define pitch::semitone-vec #(0 2 4 5 7 9 11))
 
 (define (pitch::semitone pitch)
@@ -319,12 +345,13 @@ dump reinterpret the markup as a molecule.
        (chord::additions->markup-banter (cdr additions) subtractions)))
       empty-markup))
 
-(define (chord::subtractions->markup-banter subtractions)       
+(define (chord::subtractions->markup-banter subtractions)
   (if (pair? subtractions)
       (make-line-markup
        (list
        (make-simple-markup "no")
-       (let ((step (step->markup-jazz (car subtractions))))
+       (let ((step (step->markup-previously-jazz
+                    (car subtractions))))
          (if (pair? (cdr subtractions))
              (make-line-markup
               (list step (make-simple-markup "/")))
@@ -358,15 +385,21 @@ dump reinterpret the markup as a molecule.
 
 "
   (let* ((tonic-markup (pitch->chord-name-markup-banter tonic steps))
-        (except-markup
-
-         (if exception-part exception-part empty-markup))  ;;(make-simple-markup "")))
-        (sep-markup (make-simple-markup
-                     (if (and (string-match "super"
-                                            (format "~s" except-markup))
-                              (or (pair? additions)
-                                  (pair? subtractions)))
-                         "/" "")))
+        (except-markup (if exception-part exception-part empty-markup))
+        (sep-markup (if (and exception-part
+                             (let ((s (format "~s" except-markup)))
+                               (and
+                                (string-match "super" s)
+                                ;; ugh ugh
+                                ;; python: `except_markup`[-5:] != '"o"))'
+                                (not (equal?
+                                      "\"o\"))"
+                                      (substring s
+                                                 (- (string-length s) 5))))))
+                             (or (pair? additions)
+                                 (pair? subtractions)))
+                        (make-super-markup (make-simple-markup "/"))
+                        empty-markup))
         (adds-markup (chord::additions->markup-banter additions subtractions))
         (subs-markup (chord::subtractions->markup-banter subtractions))
         (b+i-markup (chord::bass-and-inversion->markup-banter
@@ -377,8 +410,7 @@ dump reinterpret the markup as a molecule.
       tonic-markup
       except-markup
       sep-markup
-      (make-raise-markup
-       0.3
+      (make-normal-size-super-markup
        (make-line-markup (list adds-markup subs-markup)))
       b+i-markup))))
 
@@ -406,10 +438,10 @@ dump reinterpret the markup as a molecule.
   ;; this is unintelligible.
   ;;
   (define (chord::exceptions-lookup-helper
-          exceptions-alist try-steps unmatched-steps exception-part)
+          exception-alist try-steps unmatched-steps exception-part)
     "
 
- check exceptions-alist for biggest matching part of try-steps
+ check exception-alist for biggest matching part of try-steps
  return (MATCHED-EXCEPTION . UNMATCHED-STEPS)
 
 "
@@ -423,13 +455,13 @@ dump reinterpret the markup as a molecule.
        (let ((entry (assoc
                      (map (lambda (x) (pitch->note-name x))
                           (append '((0 0 0)) try-steps))
-                     exceptions-alist)))
+                     exception-alist)))
          (if entry
              (chord::exceptions-lookup-helper
               #f '() unmatched-steps (cdr entry))
              (let ((r (reverse try-steps)))
                (chord::exceptions-lookup-helper
-                exceptions-alist
+                exception-alist
                 (reverse (cdr r))
                 (cons (car r) unmatched-steps) #f))))
        (cons exception-part unmatched-steps)))
@@ -480,13 +512,18 @@ dump reinterpret the markup as a molecule.
       ((2) (accidental->markup 2)))
     (make-simple-markup (number->string (+ (cadr pitch) (if (= (car pitch) 0) 1 8)))))
 
-(define-public chord::names-alist-american 
+(define-public chord::exception-alist-american 
   `(
-    (((0 . 0)) . ,empty-markup)
     (((0 . 0)) . ,empty-markup)
     (((0 . 0) (2 . -1)) . ,(make-simple-markup "m"))
-    (((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 ")))
-    (((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 ")))
+    
+    ;; these should probably be normal-size?  --jcn
+    ;;(((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 ")))
+    ;;(((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 ")))
+    
+    (((0 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "5 ")))
+    (((0 . 0) (1 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "2 ")))
+    
     ;;choose your symbol for the fully diminished chord
     (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-simple-markup "dim"))
     ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-line-markup (list empty-markup (make-super-markup (make-simple-markup "o")))))
@@ -600,8 +637,7 @@ dump reinterpret the markup as a molecule.
     (make-line-markup
      (list
       tonic-markup except-markup sep-markup
-      (make-raise-markup
-       0.3
+      (make-normal-size-super-markup
        (make-line-markup (list pref-markup suff-markup)))
       b+i-markup))))
 
@@ -638,15 +674,20 @@ dump reinterpret the markup as a molecule.
 ;; Jazz chords, by Atte Andr'e Jensen <atte@post.com>
 ;; Complete rewrite by Amelie Zapf (amy@loueymoss.com)
 
-;; FIXME: identical to chord::names-alist-american, apart from commented
+;; FIXME: identical to chord::exception-alist-american, apart from commented
 ;;        dim chord.  should merge.
-(define-public chord::names-alist-jazz 
+(define-public chord::exception-alist-jazz 
   `(
-    (((0 . 0)) . ,empty-markup)
     (((0 . 0)) . ,empty-markup)
     (((0 . 0) (2 . -1)) . ,(make-simple-markup "m"))
-    (((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 ")))
-    (((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 ")))
+
+    ;; these should probably be normal-size?  --jcn
+    ;;(((0 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "5 ")))
+    ;;(((0 . 0) (1 . 0) (4 . 0)) . ,(make-super-markup (make-simple-markup "2 ")))
+    
+    (((0 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "5 ")))
+    (((0 . 0) (1 . 0) (4 . 0)) . ,(make-normal-size-super-markup (make-simple-markup "2 ")))
+    
     ;;choose your symbol for the fully diminished chord
     ;;(((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-simple-markup "dim"))
     (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ,(make-line-markup (list (make-simple-markup "") (make-super-markup (make-simple-markup "o")))))
@@ -768,8 +809,7 @@ dump reinterpret the markup as a molecule.
     (make-line-markup
      (list
       tonic-markup except-markup sep-markup
-      (make-raise-markup
-       0.3
+      (make-normal-size-super-markup
        (make-line-markup (list pref-markup suff-markup)))
       b+i-markup))))
 
@@ -859,11 +899,14 @@ inline use in .ly file"
   (ly:export
    (case sym
      ((jazz)
-      (chord-name-style-setter chord->markup-jazz chord::names-alist-jazz))
+      (chord-name-style-setter chord->markup-jazz
+                              chord::exception-alist-jazz))
      ((banter)
-      (chord-name-style-setter chord->markup-banter chord::names-alist-banter))
+      (chord-name-style-setter chord->markup-banter
+                              chord::exception-alist-banter))
      ((american)
-      (chord-name-style-setter chord->markup-american chord::names-alist-american))
+      (chord-name-style-setter chord->markup-american
+                              chord::exception-alist-american))
      )))
 
 

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index 58f8ca0ffd54d0446bdf76364788325a96938a2d..b94065358636297b5663b7133b63eff9c088f5f2 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -163,7 +163,7 @@ for the reader.
                              (car rest) Y)
   )
 
-(define-public (normal-size-superscript-markup grob props . rest)
+(define-public (normal-size-super-markup grob props . rest)
   (ly:molecule-translate-axis (interpret-markup
                               grob
                               props (car rest))
@@ -197,6 +197,15 @@ for the reader.
                              Y)
   )
 
+(define-public (normal-size-sub-markup grob props . rest)
+  (ly:molecule-translate-axis (interpret-markup
+                              grob
+                              props (car rest))
+                             (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
+                             Y)
+  )
+
+
 ;; todo: fix negative space
 (define (hspace-markup grob props . rest)
   "Syntax: \\hspace NUMBER."
@@ -366,7 +375,10 @@ for the reader.
 
    ;; 
    (cons sub-markup (list markup?))
+   (cons normal-size-sub-markup (list markup?))
+   
    (cons super-markup (list markup?))
+   (cons normal-size-super-markup (list markup?))
    
    (cons bold-markup (list markup?))
    (cons italic-markup (list markup?))