lib/libdynamics.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- libdynamics.scm                                    ;
   3 ;                                                                  ;
   4 ; (c) 2008-2011 Valentin Villenave <valentin@villenave.net>        ;
   5 ;                                                                  ;
   6 ;     opus_libre is a free framework for GNU LilyPond: you may     ;
   7 ; redistribute it and/or modify it under the terms of the GNU      ;
   8 ; General Public License as published by the Free Software         ;
   9 ; Foundation, either version 3 of the License, or (at your option) ;
  10 ; any later version.                                               ;
  11 ;     This program is distributed WITHOUT ANY WARRANTY; without    ;
  12 ; even the implied warranty of MERCHANTABILITY or FITNESS FOR A    ;
  13 ; PARTICULAR PURPOSE.  You should have received a copy of the GNU  ;
  14 ; General Public License along with this program (typically in the ;
  15 ; share/doc/ directory).  If not, see http://www.gnu.org/licenses/ ;
  16 ;                                                                  ;
  17 ;------------------------------------------------------------------;
  18
  19
  20 ; Dynamic functions.
  21
  22 ;; automatic dynamics
  23 (define (dynamic? x)
  24   (let ((name (ly:music-property x 'name)))
  25     (or
  26      (eq? name 'DynamicEvent)
  27      (eq? name 'AbsoluteDynamicEvent)
  28      (eq? name 'CrescendoEvent)
  29      (eq? name 'DecrescendoEvent)
  30      (eq? name 'SpanDynamicEvent))))
  31
  32 (define keepDyn
  33 ;; Tag all dynamics in MUSIC.
  34   (define-music-function (music) (ly:music?)
  35     (music-filter
  36      (lambda (x)
  37        (if (dynamic? x)
  38            (set! (ly:music-property x 'tags)
  39                  (cons 'staff-dynamics
  40                        (ly:music-property x 'tags))))
  41        x) music)))
  42
  43 (define removeDynamics
  44 ;; Remove untagged dynamics.
  45   (define-music-function (music) (ly:music?)
  46     (if (ly:get-option 'no-auto-piano-dynamics)
  47         music
  48         (music-filter
  49          (lambda (x)
  50            (let ((tags (ly:music-property x 'tags))
  51                  (dir (ly:music-property x 'direction)))
  52              (not (and
  53                    (dynamic? x)
  54                    (not (memq 'staff-dynamics tags))
  55                    (null? dir)))))
  56          music))))
  57
  58 (define filterDynamics
  59 ;; Like \removeWithTag, but will not affect other contexts
  60 ;; (i.e. no \change, no \bar or \time etc.)
  61   (define-music-function (music) (ly:music?)
  62     (if (ly:get-option 'no-auto-piano-dynamics)
  63         (make-music 'Music 'void #t)
  64         (music-filter
  65           (lambda (x)
  66             (let ((name (ly:music-property x 'name))
  67                   (tags (ly:music-property x 'tags))
  68                   (dir (ly:music-property x 'direction)))
  69               (not (or
  70                     (eq? name 'ContextChange)
  71                     (eq? name 'VoiceSeparator)
  72                     ;(eq? name 'ContextSpeccedMusic)
  73                     (memq 'staff-dynamics tags)
  74                     (ly:dir? dir)))))
  75           music))))