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
  15 (define-public (format-new-bass-figure figure event context)
  16   (let* ((fig (ly:music-property event 'figure))
  17          (fig-markup (markup #:number (number->string figure 10)))
  18
  19          (alt (ly:music-property event 'alteration))
  20          (alt-markup
  21           (if (number? alt)
  22               (alteration->text-accidental-markup alt)
  23               #f))
  24          (alt-dir (ly:context-property context 'figuredBassAlterationDirection))
  25
  26          )
  27
  28     (if alt-markup
  29         (set! fig-markup
  30               (markup #:put-adjacent fig-markup X
  31                       (if (number? alt-dir)
  32                           alt-dir
  33                           LEFT)
  34                       #:raise .33
  35                       #:pad-around 0.5 #:smaller alt-markup )))
  36
  37     fig-markup))
  38
  39 (define-public (format-bass-figure figures context grob)
  40   ;; TODO: support slashed numerals here.
  41   (define (fig-to-markup fig-music)
  42     (let* ((align-accs
  43             (eq? #t (ly:context-property context 'alignBassFigureAccidentals)))
  44            (fig (ly:music-property fig-music 'figure))
  45            (acc (ly:music-property fig-music 'alteration))
  46            (acc-markup #f)
  47            (fig-markup
  48             (if (markup? fig)
  49                 fig
  50                 (if align-accs (make-simple-markup " ")
  51                     (if (not (eq? acc '()))
  52                         (make-simple-markup "")
  53                         (make-strut-markup))))))
  54
  55       (if (number? acc)
  56           (make-line-markup (list fig-markup
  57                                   (alteration->text-accidental-markup acc)))
  58           fig-markup)))
  59
  60   (define (filter-brackets i figs acc)
  61     (cond
  62      ((null? figs) acc)
  63      (else
  64       (filter-brackets (1+ i) (cdr figs)
  65
  66                        (append
  67                         (if (eq? (ly:music-property (car figs) 'bracket-start) #t)
  68                              (list i)
  69                              '())
  70                         (if (eq? (ly:music-property (car figs) 'bracket-stop) #t)
  71                              (list i)
  72                              '())
  73
  74                         acc)))))
  75
  76   (set! (ly:grob-property grob 'text)
  77         (make-bracketed-y-column-markup
  78          (sort (filter-brackets 0 figures '()) <)
  79          (map fig-to-markup figures))))