scm/bass-figure.scm

   1 ;;;; bass-figure.scm -- implement Scheme output routines for TeX
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;;                 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8
   9 (ly:add-interface
  10  'bass-figure-interface
  11  "A bass figure, including bracket"
  12  '())
  13
  14 (define-public (format-bass-figure figures context grob)
  15   ;; TODO: support slashed numerals here.
  16   (define (fig-to-markup fig-music)
  17     (let* ((align-accs
  18             (eq? #t (ly:context-property context 'alignBassFigureAccidentals)))
  19            (fig (ly:music-property fig-music 'figure))
  20            (acc (ly:music-property fig-music 'alteration))
  21            (acc-markup #f)
  22            (fig-markup
  23             (if (markup? fig)
  24                 fig
  25                 (if align-accs (make-simple-markup " ")
  26                     (if (not (eq? acc '()))
  27                         (make-simple-markup "")
  28                         (make-strut-markup))))))
  29
  30       (if (number? acc)
  31           (make-line-markup (list fig-markup
  32                                   (alteration->text-accidental-markup acc)))
  33           fig-markup)))
  34
  35   (define (filter-brackets i figs acc)
  36     (cond
  37      ((null? figs) acc)
  38      (else
  39       (filter-brackets (1+ i) (cdr figs)
  40
  41                        (append
  42                         (if (eq? (ly:music-property (car figs) 'bracket-start) #t)
  43                              (list i)
  44                              '())
  45                         (if (eq? (ly:music-property (car figs) 'bracket-stop) #t)
  46                              (list i)
  47                              '())
  48
  49                         acc)))))
  50
  51   (set! (ly:grob-property grob 'text)
  52         (make-bracketed-y-column-markup
  53          (sort (filter-brackets 0 figures '()) <)
  54          (map fig-to-markup figures))))