1 ;;;; figured bass support ...
3 ;;;; todo: make interfaces as 1st level objects in LilyPond.
5 (define (brew-one-figure grob fig-music)
6 "Brew a single column for a music figure"
8 (mf (ly-get-font grob '( (font-family . music) )))
9 (nf (ly-get-font grob '( (font-family . number) )))
10 (mol (ly-make-molecule '() '(0 . 0) '(0 . 1.0)))
11 (fig (ly-get-mus-property fig-music 'figure))
12 (acc (ly-get-mus-property fig-music 'alteration))
17 (set! mol (fontify-text nf (number->string fig)))
18 (ly-align-to! mol Y CENTER)
23 (ly-combine-molecule-at-edge
24 mol 0 1 (ly-find-glyph-by-name mf (string-append "accidentals-" (number->string acc)))
28 (ly-align-to! mol X CENTER)
35 (define (brew-bass-figure grob)
36 "Make a molecule for a Figured Bass grob"
38 (figs (ly-get-grob-property grob 'causes ))
39 (mol (ly-make-molecule '() '(0 . 0) '(0 . 0)))
40 (padding (ly-get-grob-property grob 'padding))
41 (kerning (ly-get-grob-property grob 'kern))
43 (ly-get-paper-variable grob 'linethickness)
44 (ly-get-grob-property grob 'thickness))
50 (define (brew-complete-figure grob figs mol)
51 "recursive function: take some stuff from FIGS, and add it to MOL."
52 (define (end-bracket? fig)
53 (eq? (ly-get-mus-property fig 'bracket-stop) #t)
58 (if (eq? (ly-get-mus-property (car figs) 'bracket-start) #t)
60 (gather-todo (take-from-list-until figs '() end-bracket?))
63 (lambda (x) (brew-one-figure grob x))
64 (reverse! (car gather-todo) '())))
65 (br-mol (bracketify-molecule
66 (stack-molecules Y UP kerning unbr-mols)
67 Y thickness (* 2 padding) padding))
70 grob (cdr gather-todo)
71 (ly-combine-molecule-at-edge mol Y UP br-mol kerning)
76 (ly-combine-molecule-at-edge mol Y UP (brew-one-figure grob (car figs))
82 (set! mol (brew-complete-figure grob (reverse figs) mol))
83 (ly-align-to! mol Y DOWN)
89 'bass-figure-interface
90 "A bass figure, including bracket"
91 '(padding thickness ))