*** empty log message ***

[lilypond.git] / scm / bass-figure.scm

diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
index 136396187e34b9e858ee4c880e55e36377291523..46d4af745769d71078ea0731fff07c1b373746c1 100644 (file)
--- a/scm/bass-figure.scm
+++ b/scm/bass-figure.scm
@@ -1,62 +1,54 @@
-;;;; figured bass support ...
+;;;; bass-figure.scm -- implement Scheme output routines for TeX
+;;;;
+;;;;  source file of the GNU LilyPond music typesetter
+;;;; 
+;;;; (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;                 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
 
 (ly:add-interface
-'bass-figure-interface
+ 'bass-figure-interface
  "A bass figure, including bracket"
  '())
 
-(define  (recursive-split-at pred? l)
-  (if (null? l)
-      '()
-      (let*
-         ((x (split-at-predicate pred? l)))
-       (set-cdr! x (recursive-split-at pred? (cdr x)))
-       x
-       )))
-
-(define-public (make-bass-figure-markup figures context)
-  
-  (define (no-end-bracket? f1 f2)
-    (eq? (ly:get-mus-property f1 'bracket-stop) '())
-    )
-  (define (no-start-bracket? f1 f2)
-    (eq? (ly:get-mus-property f2 'bracket-start) '())
-    )
-
+(define-public (format-bass-figure figures context grob)
   ;; TODO: support slashed numerals here.
   (define (fig-to-markup fig-music)
-    (let*
-       ((align-accs (eq? #t (ly:get-context-property context 'alignBassFigureAccidentals)))
-        (fig  (ly:get-mus-property fig-music 'figure))
-        (acc  (ly:get-mus-property fig-music 'alteration))
-        (acc-markup #f)
-        (fig-markup
-         (if (string? fig)
-             (make-simple-markup fig)
-             (make-simple-markup (if align-accs " " ""))
-             )))
+    (let* ((align-accs
+           (eq? #t (ly:context-property context 'alignBassFigureAccidentals)))
+          (fig (ly:music-property fig-music 'figure))
+          (acc (ly:music-property fig-music 'alteration))
+          (acc-markup #f)
+          (fig-markup
+           (if (markup? fig)
+               fig
+               (if align-accs (make-simple-markup " ")
+                   (if (not (eq? acc '()))
+                       (make-simple-markup "")
+                       (make-strut-markup))))))
 
       (if (number? acc)
          (make-line-markup (list fig-markup
                                  (alteration->text-accidental-markup acc)))
-         fig-markup)
-      ))
-  
-  (define (fig-seq-to-markup figs)
-    (let*
-       (
-        (c (make-dir-column-markup (map fig-to-markup figs)))
-        )
-      (if (eq? (ly:get-mus-property (car figs) 'bracket-start) #t)
-         (make-bracket-markup c)
-         c
-         )))
-  
-  (let*
-      (
-       (ends (recursive-split-at no-end-bracket? (reverse figures)))
-       (starts (map (lambda (x) (recursive-split-at no-start-bracket? x)) ends))
-       )
-    (make-dir-column-markup (map fig-seq-to-markup (apply append starts)))
-    ))
+         fig-markup)))
+
+  (define (filter-brackets i figs acc)
+    (cond
+     ((null? figs) acc)
+     (else
+      (filter-brackets (1+ i) (cdr figs)
+
+                      (append
+                       (if (eq? (ly:music-property (car figs) 'bracket-start) #t)
+                            (list i)
+                            '())
+                       (if (eq? (ly:music-property (car figs) 'bracket-stop) #t)
+                            (list i)
+                            '())
+                       
+                       acc)))))
 
+  (set! (ly:grob-property grob 'text)
+       (make-bracketed-y-column-markup
+        (sort (filter-brackets 0 figures '()) <)
+        (map fig-to-markup figures))))