scm/auto-beam.scm

   1 ;;;
   2 ;;; auto-beam.scm -- Auto-beam-engraver settings
   3 ;;;
   4 ;;; source file of the GNU LilyPond music typesetter
   5 ;;;
   6 ;;; (c)  2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;
   8
   9 ;;; specify generic beam begin and end times
  10
  11 ;;; format:
  12 ;;;
  13 ;;;   function shortest-duration-in-beam time-signature
  14 ;;;
  15 ;;; where
  16 ;;;
  17 ;;;     function = begin or end
  18 ;;;     shortest-duration-in-beam = numerator denominator; eg: 1 16
  19 ;;;     time-signature = numerator denominator, eg: 4 4
  20 ;;;
  21 ;;; unspecified or wildcard entries for duration or time-signature
  22 ;;; are given by * *
  23
  24 ;;; maybe do:  '(end shortest-1 16 time-3 4) ?
  25
  26 ;;; in 3 2 time:
  27 ;;;   end beams each 1 2 note
  28 ;;;   end beams with 16th notes each 1 4 note
  29 ;;;   end beams with 32th notes each 1 8 note
  30
  31 (define-public default-auto-beam-settings
  32    `(
  33      ((end * * 3 2) . ,(ly:make-moment 1 2))
  34      ((end 1 16 3 2) . ,(ly:make-moment 1 4))
  35      ((end 1 32 3 2) . ,(ly:make-moment 1 8))
  36
  37      ((begin 1 8 3 4) . ,(ly:make-moment 1 4))
  38
  39      ((end * * 3 4) . ,(ly:make-moment 3 4))
  40      ((begin 1 16 3 4) . ,(ly:make-moment 1 16))
  41      ((end 1 16 3 4) . ,(ly:make-moment 1 4))
  42      ;;((begin 1 32 3 4) . ,(ly:make-moment 1 8))
  43      ((end 1 32 3 4) . ,(ly:make-moment 1 8))
  44
  45      ((begin 1 16 3 8) . ,(ly:make-moment 1 8))
  46      ((end * * 3 8) . ,(ly:make-moment 3 8))
  47
  48      ;; in common time:
  49      ;;   end beams each 1 2 note
  50      ;;   end beams with 32th notes each 1 8 note
  51      ;;   end beams with 1 8 triplets each 1 4 note
  52
  53      ((end * * 4 4) . ,(ly:make-moment 1 2))
  54      ((end 1 12 4 4) . ,(ly:make-moment 1 4))
  55      ((end 1 16 4 4) . ,(ly:make-moment 1 4))
  56      ((end 1 32 4 4) . ,(ly:make-moment 1 8))
  57
  58      ((end * * 2 4) . ,(ly:make-moment 1 4))
  59      ((end 1 12 2 4) . ,(ly:make-moment 1 4))
  60      ((end 1 16 2 4) . ,(ly:make-moment 1 4))
  61      ((end 1 32 2 4) . ,(ly:make-moment 1 8))
  62
  63      ;; It seems that, because of a bug in the previous auto-beamer,
  64      ;; we had the effect of this setting x
  65      ;; ((end * * 2 8) . ,(ly:make-moment 2 8))
  66
  67      ((end * * 4 8) . ,(ly:make-moment 1 4))
  68      ((end 1 16 4 8) . ,(ly:make-moment 1 4))
  69      ((end 1 32 4 8) . ,(ly:make-moment 1 8))
  70
  71      ((end * * 4 16) . ,(ly:make-moment 1 8))
  72
  73      ((end * * 6 8) . ,(ly:make-moment 3 8))
  74      ((end 1 16 6 8) . ,(ly:make-moment 3 8))
  75      ((end 1 32 6 8) . ,(ly:make-moment 1 8))
  76
  77      ((end * * 9 8) . ,(ly:make-moment 3 8))
  78      ((end 1 16 9 8) . ,(ly:make-moment 3 8))
  79      ((end 1 32 9 8) . ,(ly:make-moment 1 8))
  80
  81      ((end * * 12 8) . ,(ly:make-moment 3 8))
  82      ((end 1 16 12 8) . ,(ly:make-moment 3 8))
  83      ((end 1 32 12 8) . ,(ly:make-moment 1 8))
  84      ))
  85
  86
  87 (define (override-property-setting context context-prop setting value)
  88   "Like the C++ code that executes \\override, but without type
  89 checking. "
  90
  91   (ly:set-context-property! context context-prop
  92                            (cons (cons setting value)
  93                                  (ly:get-context-property context context-prop)
  94                                  )
  95                            )
  96   )
  97
  98 (define (revert-property-setting context setting)
  99   "Like the C++ code that executes \revert, but without type
 100 checking. "
 101
 102   (define (revert-assoc alist key)
 103     "Return ALIST, with KEY removed. ALIST is not modified, instead
 104 a fresh copy of the  list-head is made."
 105     (cond
 106      ((null? alist) '())
 107      ((equal? (caar alist) key) (cdr alist))
 108      (else (cons (car alist) (revert-assoc alist key)))
 109      ))
 110
 111
 112
 113     (ly:set-context-property!
 114      context context-prop
 115      (revert-assoc (ly:get-context-property context context-prop)
 116                    setting))
 117   )
 118
 119 (define-public (override-auto-beam-setting setting num den . rest)
 120   (ly:export
 121    (context-spec-music
 122     (make-apply-context (lambda (c)
 123                           (override-property-setting
 124                            c 'autoBeamSettings
 125                            setting (ly:make-moment num den))
 126                           ))
 127     (if (and (pair? rest) (symbol? (car rest)))
 128         (car rest)
 129         'Voice)
 130   )))
 131
 132 (define-public (revert-auto-beam-setting setting . rest)
 133   (ly:export
 134    (context-spec-music
 135     (make-apply-context (lambda (c)
 136                           (revert-property-setting
 137                            c 'autoBeamSettings
 138                            setting)))
 139     (if (and (pair? rest) (symbol? (car rest)))
 140         (car rest)
 141         'Voice))))
 142