*** empty log message ***

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

diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
index 3b84c6d7c90eb86a4cde5a578d015f5bbc8c4d03..46d4af745769d71078ea0731fff07c1b373746c1 100644 (file)
--- a/scm/bass-figure.scm
+++ b/scm/bass-figure.scm
@@ -1,91 +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* (
-        (mf (ly-get-font grob '( (font-family .  music)  )))
-        (nf (ly-get-font grob '( (font-family .  number)  )))
-        (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-align-to! mol Y CENTER)
-       ))
-    
-    (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)))
-              0.2))
-       )
-    (if (molecule? mol)
-       (ly-align-to! mol X CENTER)
-       )
-    mol))
-
-
-
-
-(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))
-                   )
-        )
-
-
-
-    (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 UP kerning unbr-mols)
-                             Y thickness (* 2 padding) padding))
-                    )
-               (brew-complete-figure
-                grob (cdr gather-todo)
-                (ly-combine-molecule-at-edge mol Y UP br-mol kerning)
-                )
-               )
-             (brew-complete-figure
-              grob (cdr figs)
-              (ly-combine-molecule-at-edge mol Y UP (brew-one-figure grob (car figs))
-                                           kerning))
-             )
-         ))
-
-    
-    (set! mol (brew-complete-figure grob (reverse figs) mol))
-    (ly-align-to! mol Y DOWN)
-    mol
-    ))
-
-
-(ly-add-interface
-'bass-figure-interface
+(ly:add-interface
+ 'bass-figure-interface
  "A bass figure, including bracket"
- '(padding thickness ))
+ '())
+
+(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))))))
+
+      (if (number? acc)
+         (make-line-markup (list fig-markup
+                                 (alteration->text-accidental-markup acc)))
+         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))))