partial move to new markup texts.

diff --git a/ChangeLog b/ChangeLog
index e6de39984a37929a6d04c0f050727495ec585588..4b565448fe4a4e8351f70c627c8740a9d45f21a2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2002-12-20  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
+
+       * scm/chord-name.scm: partial move to new markup texts.
+
 2002-12-18  Han-Wen Nienhuys  <hanwen@cs.uu.nl>
 
        * scm/grob-description.scm (all-grob-descriptions): small bass figures.

diff --git a/input/regression/new-markup-syntax.ly b/input/regression/new-markup-syntax.ly
index 9235105a2bbe94ef180e78f232ce103c44a7427a..f0ab8091d3461519d53993730689bb2034b1df76 100644 (file)
--- a/input/regression/new-markup-syntax.ly
+++ b/input/regression/new-markup-syntax.ly
@@ -22,7 +22,9 @@ texidoc = "New markup syntax."
                \combine "o" "/"
                "$\\emptyset$"
                \italic Norsk
+               \super "2"
                \dynamic sfzp
+               \sub "alike"
        }       
     c''4
     }

diff --git a/lily/input-file-results.cc b/lily/input-file-results.cc
index c0cc86763ac0e7838a064100b51ab080baf9d27f..5d78d9ef508e9e7fae20bd71073cf82d416bacf2 100644 (file)
--- a/lily/input-file-results.cc
+++ b/lily/input-file-results.cc
@@ -36,7 +36,7 @@
 /*
   no ! suffix since it doesn't modify 1st argument.
  */
-LY_DEFINE(ly_set_point_and_click_x, "ly:set-point-and-click", 1, 0, 0,
+LY_DEFINE(ly_set_point_and_click, "ly:set-point-and-click", 1, 0, 0,
          (SCM what),
          "Set the options for Point-and-click source specials output. The\n"
 "argument is a symbol.  Possible options are @code{none} (no source specials),\n"

diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
index 7fffa874e54229b6448cadacd17966ea47219492..4f26ba953d05756e3298df405484586d3972e07d 100644 (file)
--- a/scm/bass-figure.scm
+++ b/scm/bass-figure.scm
@@ -25,7 +25,7 @@
     (if (number? acc)
        (set! mol
              (ly:combine-molecule-at-edge
-              mol 0 1 (ly:find-glyph-by-name mf (string-append "accidentals-" (number->string acc)))
+              mol X RIGHT (ly:find-glyph-by-name mf (string-append "accidentals-" (number->string acc)))
               0.2))
        )
     (if (ly:molecule? mol)

diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 951a752327cbcb8eb9084465385bde8ab4541fd0..e3af03c19ffbebbb68f68228197a4ad47c608bcf 100644 (file)
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -41,28 +41,32 @@
 (define-public chord::names-alist-banter '())
 (set! chord::names-alist-banter
       (append 
-       '(
+       `(
        ; C iso C.no3.no5
-       (((0 . 0)) . #f)
+       (((0 . 0)) . (,simple-markup ""))
        ; C iso C.no5
-       (((0 . 0) (2 . 0)) . #f)
+       (((0 . 0) (2 . 0)) . (,simple-markup ""))
        ; Cm iso Cm.no5
-       (((0 . 0) (2 . -1)) . ("m"))
+       (((0 . 0) (2 . -1)) . (,simple-markup "m"))
        ; C2 iso C2.no3
-       (((0 . 0) (1 . 0) (4 . 0)) . ("" (super "2") " "))
+       (((0 . 0) (1 . 0) (4 . 0)) . (,super-markup (,simple-markup "2 ")))
        ; C4 iso C4.no3
-       (((0 . 0) (3 . 0) (4 . 0)) . ("" (super "4") " " ))
+       (((0 . 0) (3 . 0) (4 . 0)) . (,super-markup (,simple-markup "4 ")))
        ;; Cdim iso Cm5-
-       (((0 . 0) (2 . -1) (4 . -1)) . ("dim"))
+       (((0 . 0) (2 . -1) (4 . -1)) . (,simple-markup "dim"))
        ; URG: Simply C:m5-/maj7 iso Cdim maj7
-       (((0 . 0) (2 . -1) (4 . -1) (6 . 0)) . ("m" (super "5-/maj7" " ")))
+       (((0 . 0) (2 . -1) (4 . -1) (6 . 0)) . (,line-markup ((,simple-markup "m") (,super-markup "5-/maj7 "))))
        ; URG: Simply C:m5-/7 iso Cdim7
-       (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . ("m" (super "5-/7" " ")))
+       (((0 . 0) (2 . -1) (4 . -1) (6 . -1)) . (,line-markup ((,simple-markup "m") (,super-markup "5-/7 "))))
        ; Co iso C:m5-/7-
-        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . ("" (super "o") " "))
+        (((0 . 0) (2 . -1) (4 . -1) (6 . -2)) . (,super-markup (,simple-markup "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)) . (,line-markup ((,simple-markup "dim")
+                                                                       (,simple-markup "9 "))))
+       (((0 . 0) (2 . -1) (4 . -1) (6 . -2) (1 . -1) (3 . -1))
+        . (,line-markup ((,simple-markup "dim")
+                         (,super-markup (,simple-markup "11 ")))))
+       
        )
       chord::names-alist-banter))
 
@@ -85,14 +89,20 @@
 (define (pitch->note-name pitch)
   (cons (cadr pitch) (caddr pitch)))
 
+(define (accidental-markup acc)
+  (if (= acc 0)
+      (list simple-markup "")
+      (list musicglyph-markup (string-append "accidentals-" (number->string acc)))
+  ))
+
 (define (pitch->text pitch)
-  (text-append
+  (list line-markup
    (list
-    '(font-relative-size . 2)
-    (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65))))
-   (accidental->text-super (caddr pitch))))
-
-
+    (list simple-markup
+         (make-string 1 (integer->char (+ (modulo (+ (cadr pitch) 2) 7) 65))))
+    (list normal-size-superscript-markup
+         (accidental-markup (caddr pitch))))))
+  
 ;;; Hooks to override chord names and note names, 
 ;;; see input/tricks/german-chords.ly
 
@@ -120,14 +130,14 @@
 (define (step->text-banter pitch)
   (if (= (cadr pitch) 6)
       (case (caddr pitch)
-       ((-2) '("7-"))
-       ((-1) '("7"))
-       ((0) '("maj7"))
-       ((1) '("7+"))
-       ((2) '("7+")))
+       ((-2) (list simple-markup "7-"))
+       ((-1) (list simple-markup "7"))
+       ((0) (list simple-markup "maj7"))
+       ((1) (list simple-markup "7+"))
+       ((2) (list simple-markup "7+")))
       (step->text pitch)))
 
-(define pitch::semitone-vec (list->vector '(0 2 4 5 7 9 11)))
+(define pitch::semitone-vec #(0 2 4 5 7 9 11))
 
 (define (pitch::semitone pitch)
   (+ (* (car pitch) 12) 
@@ -163,32 +173,6 @@
 (define (chord::text? text)
   (not (or (not text) (null? 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.
-   This allows us to leave else parts of (if # #) off.
-   Otherwise, you'd have to do (if # # '()), and you'd have to
-   filter-out the '() anyway.
-  "
-  (if (pair? dirty)
-      (let ((r (car dirty)))
-       (if (chord::text? r)
-           (cons (if (pair? r) (chord::text-cleanup r) r)
-                 (chord::text-cleanup (cdr dirty)))
-           (chord::text-cleanup (cdr dirty))))
-      (if (chord::text? dirty)
-         dirty
-         '())))
-
-(define (text-append l . r)
-  (if (not (chord::text? r))
-      l
-      (if (not (chord::text? l))
-         r
-         (if (null? (cdr r))
-             (list 'columns l (car r))
-             (text-append (list 'columns l (car r)) (cdr r))))))
           
 (define (chord::step tonic pitch)
  (- (pitch::note-pitch pitch) (pitch::note-pitch tonic)))
@@ -275,35 +259,47 @@
 
 (define (chord::additions->text-banter additions subtractions)
   (if (pair? additions)
-      (text-append
-       (let ((step (step->text-banter (car additions))))
-        (if (or (pair? (cdr additions))
-                (pair? subtractions))
-            (text-append step "/")
-            step))
-      (chord::additions->text-banter (cdr additions) subtractions))
-  '()))
+      (list line-markup
+           (list 
+            (let ((step (step->text-banter (car additions))))
+              (if (or (pair? (cdr additions))
+                      (pair? subtractions))
+                  (list line-markup
+                        (list step (list simple-markup "/")))
+                  step))
+            
+            (chord::additions->text-banter (cdr additions) subtractions)))
+      (list simple-markup "")
+
+      ))
 
 (define (chord::subtractions->text-banter subtractions)         
   (if (pair? subtractions)
-      (text-append
-       '("no")
-       (let ((step (step->text-jazz (car subtractions))))
-        (if (pair? (cdr subtractions))
-                       (text-append step "/")
-                       step))
-       (chord::subtractions->text-banter (cdr subtractions)))
-      '()))
+      (list line-markup 
+           (list simple-markup "no")
+           (let ((step (step->text-jazz (car subtractions))))
+             (if (pair? (cdr subtractions))
+                 (list line-markup (list  step (list simple-markup "/")))
+                 step))
+           (chord::subtractions->text-banter (cdr subtractions)))
+      (list simple-markup "")
+      ))
 
 (define (chord::bass-and-inversion->text-banter bass-and-inversion)
   (if (and (pair? bass-and-inversion)
           (or (car bass-and-inversion)
               (cdr bass-and-inversion)))
-      (list "/" (if (car bass-and-inversion)
-                   (pitch->note-name-text-banter
-                    (car bass-and-inversion))
-                   (pitch->note-name-text-banter
-                    (cdr bass-and-inversion))))))
+      (list
+       line-markup
+       (list
+       (list simple-markup "/")
+       (pitch->note-name-text-banter   
+        (if (car bass-and-inversion)
+            (car bass-and-inversion)
+            (cdr bass-and-inversion)))
+       ))
+      (list simple-markup "")
+      ))
 
 ;; FIXME: merge this function with inner-name-jazz, -american
 ;;        iso using chord::bass-and-inversion->text-banter,
@@ -317,18 +313,26 @@
                                  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" except-text))
-                           (or (pair? additions)
-                               (pair? subtractions)))
-                      (list simple-super "/")))
+        (sep-text (list simple-markup
+                        (if (and (string-match "super" (format "~s" except-text))
+                                 (or (pair? additions)
+                                     (pair? subtractions)))
+                            "/" "") 
+                      ))
         (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)
-     (list (list '((raise . 1) (font-relative-size . -1))) adds-text subs-text)
-     b+i-text)))
+    
+    `(,line-markup
+      (,tonic-text
+       ,except-text
+       ,sep-text
+       (,raise-markup 0.3
+       (,line-markup (,adds-text ,subs-text))
+       )
+       ,b+i-text
+       ))
+    ))
 
 (define (c++-pitch->scm p)
   (if (ly:pitch? p)
@@ -339,14 +343,17 @@
                            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)
-  (primitive-eval (string->symbol
-           (string-append (symbol->string name)
-                          (symbol->string style)))))
+  (primitive-eval ;;   "UGGHGUGHUGHG"
+
+   (string->symbol
+    (string-append (symbol->string name)
+                  (symbol->string style)))))
 
 ;; check exceptions-alist for biggest matching part of try-steps
 ;; return (MATCHED-EXCEPTION . UNMATCHED-STEPS)
@@ -398,9 +405,14 @@
   (let* ((lookup (chord::exceptions-lookup style steps))
         (exception-part (car lookup))
         (unmatched-steps (cadr lookup)))
-    (chord::text-cleanup
-     ((chord::restyle 'chord::name- style)
-      tonic exception-part unmatched-steps bass-and-inversion steps))))
+    
+    ((chord::restyle 'chord::name- style)
+      tonic exception-part unmatched-steps bass-and-inversion steps)))
+
+(define (mydisplay x)
+  (display x)
+  (newline)
+  x)
 
 ;; C++ entry point
 ;; 
@@ -422,10 +434,7 @@
                                         (pitch::transpose x diff))
                                       (cdr pitches))
                    '())))
-;    (display (chord::name->text style (car pitches) steps bass-and-inversion))
     (chord::name->text style (car pitches) steps bass-and-inversion)
-
-
     ))
 
 ;;;
@@ -846,3 +855,31 @@ If we encounter a chromatically altered step, turn on list-step
        )
       ;; '()))
       chord::names-alist-american))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(define-public (new-chord-name-brew-molecule grob)
+  (let*
+      (
+       (style-prop (ly:get-grob-property grob 'style))
+       (style (if (symbol? style-prop) style-prop  'banter))
+       (chord (ly:get-grob-property grob 'chord))
+       (chordf (ly:get-grob-property grob 'chord-name-function))
+       (ws (ly:get-grob-property grob 'word-space))
+       (markup (chordf style chord))
+       (molecule (interpret-markup grob
+                                  (cons '((word-space . 0.0))
+                                        (Font_interface::get_property_alist_chain grob))
+                                  markup))
+       )
+
+
+    ;;;  TODO: BUG : word-space is in local staff-space (?)
+    (if (number? ws)
+       (ly:combine-molecule-at-edge  molecule
+        X RIGHT (ly:make-molecule "" (cons 0 ws) '(-1 . 1) )
+        0.0)
+       molecule)
+       ))
+

diff --git a/scm/lily.scm b/scm/lily.scm
index 51a2dd819b9a5a9cae7ac6b79c7779e20862edc1..23adcab42ba601abad9a0e373f087ce75f2ca597 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -231,6 +231,7 @@ is the  first to satisfy CRIT
        "music-functions.scm"
        "music-property-description.scm"
        "auto-beam.scm"
+       "new-markup.scm"
        "basic-properties.scm"
        "chord-name.scm"
        "grob-description.scm"
@@ -238,6 +239,7 @@ is the  first to satisfy CRIT
        "script.scm"
        "drums.scm"
        "midi.scm"
-       "new-markup.scm"
        ))
 
+
+       

diff --git a/scm/new-markup.scm b/scm/new-markup.scm
index 7e3b37b6355cf854f386b2c125bfb0940a4940fe..7b1f76974b4d25b65fb5294711673aac0388c630 100644 (file)
--- a/scm/new-markup.scm
+++ b/scm/new-markup.scm
@@ -101,17 +101,30 @@
 (define-public (char-markup grob props . rest)
   "Syntax: \\char NUMBER. "
   (ly:get-glyph  (ly:get-font grob props) (car rest))
-                
   )
+
 (define-public (raise-markup grob props  . rest)
   "Syntax: \\raise AMOUNT MARKUP. "
-  (ly:molecule-translate-axis (interpret-markup grob props (cadr rest))
+  (ly:molecule-translate-axis (interpret-markup
+                              grob
+                              props
+                              (cadr rest))
                              (car rest) Y)
   )
 
+(define-public (normal-size-superscript-markup grob props . rest)
+  (ly:molecule-translate-axis (interpret-markup
+                              grob
+                              props (car rest))
+                             (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
+                             Y)
+  )
+
 (define-public (super-markup grob props  . rest)
   "Syntax: \\super MARKUP. "
-  (ly:molecule-translate-axis (interpret-markup grob props (car rest))
+  (ly:molecule-translate-axis (interpret-markup
+                              grob
+                              (cons '((font-relative-size . -2)) props) (car rest))
                              (* 0.5 (cdr (chain-assoc 'baseline-skip props)))
                              Y)
   )
@@ -125,7 +138,10 @@
 
 (define-public (sub-markup grob props  . rest)
   "Syntax: \\sub MARKUP."
-  (ly:molecule-translate-axis (interpret-markup grob props (car rest))
+  (ly:molecule-translate-axis (interpret-markup
+                              grob
+                              (cons '((font-relative-size . -2)) props)
+                              (car rest))
                              (* -0.5 (cdr (chain-assoc 'baseline-skip props)))
                              Y)
   )
@@ -160,12 +176,9 @@
       (cons sub-markup 'markup0)
       (cons super-markup 'markup0)
       (cons number-markup 'markup0)
-
       (cons column-markup 'markup-list0)
       (cons line-markup  'markup-list0)
-
       (cons combine-markup 'markup0-markup1)
-
       (cons simple-markup 'markup0)
       (cons musicglyph-markup 'scm0)
       (cons translate-markup 'scm0-markup1)
@@ -179,7 +192,6 @@
       (cons translate-markup 'scm0-markup1)
       ))
 
-
 (define markup-module (current-module))
 
 (define-public (lookup-markup-command code)
@@ -218,3 +230,5 @@
 
 (define (markup-function? x)
        (object-property 'markup-signature? x))
+
+