scm/bass-figure.scm

   1 ;;;; figured bass support ...
   2
   3 (ly:add-interface
   4 'bass-figure-interface
   5  "A bass figure, including bracket"
   6  '())
   7
   8
   9
  10 (define-public (format-bass-figure figures context grob)
  11   ;; TODO: support slashed numerals here.
  12   (define (fig-to-markup fig-music)
  13     (let*
  14         ((align-accs (eq? #t (ly:context-property context 'alignBassFigureAccidentals)))
  15          (fig  (ly:music-property fig-music 'figure))
  16          (acc  (ly:music-property fig-music 'alteration))
  17          (acc-markup #f)
  18          (fig-markup
  19           (if (string? fig)
  20               (make-number-markup (make-simple-markup fig))
  21               (if align-accs (make-simple-markup " ")
  22                   (if (not (eq? acc '()))
  23                       (make-simple-markup "")
  24                       (make-strut-markup)))
  25               )))
  26
  27       (if (number? acc)
  28           (make-line-markup (list fig-markup
  29                                   (alteration->text-accidental-markup acc)))
  30           fig-markup)
  31       ))
  32
  33   (define (filter-brackets i figs acc)
  34     (cond
  35      ((null? figs) acc)
  36      (else
  37       (filter-brackets (1+ i) (cdr figs)
  38
  39                        (append
  40                         (if  (eq? (ly:music-property (car figs) 'bracket-start) #t)
  41                              (list i)
  42                              '())
  43                         (if  (eq? (ly:music-property (car figs) 'bracket-stop) #t)
  44                              (list i)
  45                              '())
  46
  47                         acc)))))
  48
  49   (set! (ly:grob-property grob 'text)
  50         (make-bracketed-y-column-markup
  51          (sort (filter-brackets 0 figures '()) <)
  52          (map fig-to-markup figures)
  53          )))