From: fred <fred>
Date: Thu, 28 Feb 2002 20:05:02 +0000 (+0000)
Subject: lilypond-1.5.35
X-Git-Tag: release/1.5.59~5687
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=c88a270c28ef0cece3670619f32754f51a36101c;p=lilypond.git

lilypond-1.5.35
---

diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm
new file mode 100644
index 0000000000..409d582245
--- /dev/null
+++ b/scm/bass-figure.scm
@@ -0,0 +1,64 @@
+;;;; figured bass support ...
+
+;;;; todo: make interfaces as 1st level objects in LilyPond.
+
+
+(define (fontify-text font-metric text)
+  "Set TEXT with font FONT-METRIC, returning a molecule."
+  (let* ((b  (ly-text-dimension font-metric text)))
+    (ly-make-molecule
+     (ly-fontify-atom font-metric `(text ,text)) (car b) (cdr b))
+    ))
+
+(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 (stack-molecules axis dir padding mols)
+  "Stack molecules MOLS in direction AXIS,DIR, using PADDING."
+  (if (null? mols)
+      '()
+      (if (pair? mols)
+	  (ly-combine-molecule-at-edge (car mols) axis dir 
+				       (stack-molecules axis dir padding (cdr mols))
+				       padding
+				       )
+	  )
+  ))
+
+(define (brew-bass-figure grob)
+  "Make a molecule for a Figured Bass grob"
+  (let* (
+	 (figs (ly-get-grob-property grob 'causes ))
+	 (fig-mols (map (lambda (x) (brew-one-figure grob x)) figs))
+	 (fig-mol (stack-molecules 1 -1 0.2 fig-mols))
+	 )
+
+    (ly-align-to! fig-mol Y DOWN)
+    fig-mol
+  ))
+