X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fbass-figure.scm;h=46d4af745769d71078ea0731fff07c1b373746c1;hb=91e7cbaa6e54e004365d28e0f10c9362a7f13320;hp=90b293f5d0e95b6aca16786a3c1d8f23a4ed6345;hpb=13e92a71b3a621afc8f904b89ffc27f474f53a3d;p=lilypond.git

diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
index 90b293f5d0..46d4af7457 100644
--- a/scm/bass-figure.scm
+++ b/scm/bass-figure.scm
@@ -1,92 +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>
 
-;;;; todo: make interfaces as 1st level objects in LilyPond.
 
-(define (brew-one-figure grob fig-music)
-  "Brew a single column for a music figure"
-  (let* (
-	 (chain (Font_interface::get_property_alist_chain grob))
-	 (mf (ly:get-font grob (cons  '((font-family . music))
-				      chain 
-				      )))
-	 (nf (ly:get-font grob
-			  (cons '((font-family . number))
-				chain)))
-	 (mol (ly:make-molecule  '() '(0 . 0) '(0 . 1.0)))
-	 (fig  (ly:get-mus-property fig-music 'figure))
-	 (acc  (ly:get-mus-property fig-music 'alteration))
-	 )
-    
-    (if (number? fig)
-	(begin
-	  (set! mol   (fontify-text nf (number->string fig)))
-	  (ly:molecule-align-to! mol Y CENTER)
-	))
-    
-    (if (number? acc)
-	(set! mol
-	      (ly:molecule-combine-at-edge
-	       mol X RIGHT (ly:find-glyph-by-name mf (string-append "accidentals-" (number->string acc)))
-	       0.2))
-	)
-    (if (ly:molecule? mol)
-	(ly:molecule-align-to! mol X CENTER)
-	)
-    mol))
+(ly:add-interface
+ 'bass-figure-interface
+ "A bass figure, including bracket"
+ '())
 
-(define (brew-bass-figure grob)
-  "Make a molecule for a Figured Bass grob"
-  (let* (
-	 (figs (ly:get-grob-property grob 'causes ))
-	 (mol (ly:make-molecule '() '(0 . 0) '(0 . 0)))
-	 (padding (ly:get-grob-property grob 'padding))
-	 (kerning (ly:get-grob-property grob 'kern))
-	 (thickness (*
-		     (ly:get-paper-variable grob 'linethickness)
-		     (ly:get-grob-property grob 'thickness))
-		    )
-	 (dir (ly:get-grob-property grob 'direction))
-	 )
+(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: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))))))
 
-    (define (brew-complete-figure grob figs mol)
-      "recursive function: take some stuff from FIGS, and add it to MOL." 
-      (define (end-bracket? fig)
-	(eq? (ly:get-mus-property fig 'bracket-stop) #t)
-	)
-      
-      (if (null? figs)
-	  mol
-	  (if (eq? (ly:get-mus-property (car figs) 'bracket-start) #t)
-	      (let* (
-		     (gather-todo (take-from-list-until figs '() end-bracket?))
-		     (unbr-mols
-		      (map
-		       (lambda (x) (brew-one-figure grob x))
-		       (reverse! (car gather-todo) '())))
-		     (br-mol (bracketify-molecule
-			      (stack-molecules Y dir kerning unbr-mols)
-			      Y thickness (* 2 padding) padding))
-		     )
-		(brew-complete-figure
-		 grob (cdr gather-todo)
-		 (ly:molecule-combine-at-edge mol Y dir br-mol kerning)
-		 )
-		)
-	      (brew-complete-figure
-	       grob (cdr figs)
-	       (ly:molecule-combine-at-edge mol Y dir (brew-one-figure grob (car figs))
-					    kerning))
-	      )
-	  ))
+      (if (number? acc)
+	  (make-line-markup (list fig-markup
+				  (alteration->text-accidental-markup acc)))
+	  fig-markup)))
 
-    
-    (set! mol (brew-complete-figure grob (reverse figs) mol))
-    (ly:molecule-align-to! mol Y (- dir))
-    mol
-    ))
+  (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)))))
 
-(ly:add-interface
-'bass-figure-interface
- "A bass figure, including bracket"
- '(padding thickness direction))
+  (set! (ly:grob-property grob 'text)
+	(make-bracketed-y-column-markup
+	 (sort (filter-brackets 0 figures '()) <)
+	 (map fig-to-markup figures))))