X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fbass-figure.scm;h=104793b86ffe57ea54dd63060cd4de6f161d15f0;hb=e2f5ba92300dc3fb7517165ac224e1500ad850dd;hp=b60a433eb4f2f05c08f412cae667a24ca5f960c4;hpb=27867f6fb5200743ae18e9e54eb8176e20876b59;p=lilypond.git

diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
index b60a433eb4..104793b86f 100644
--- a/scm/bass-figure.scm
+++ b/scm/bass-figure.scm
@@ -5,58 +5,49 @@
  "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))
+	((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 (number? fig)
-	      (make-number-markup (number->string fig))
-	      (make-simple-markup (if align-accs " " ""))
+	  (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)))
-    ))
 
+  (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)
+	 )))