lib/libgraphics.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- libgraphics.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 ; Graphics.
  21
  22
  23 (define (add-bracket pos up? text music)
  24   (if
  25    (equal? (ly:music-property music 'name) 'EventChord)
  26    (let ((note (car (ly:music-property music 'elements))))
  27      (set! (ly:music-property note 'articulations)
  28            (append (ly:music-property note 'articulations)
  29                    (list
  30                     (let ((obj (make-music 'FingeringEvent)))
  31                       (set! (ly:music-property obj 'tweaks)
  32                             (acons 'self-alignment-Y (if up? -1 1)
  33                                    (acons 'text
  34                                           (markup #:bracketText pos up? text)
  35                                           (ly:music-property obj 'tweaks))))
  36                       obj)))))
  37    music))
  38
  39 (define (add-script glyph music)
  40   (if
  41    (equal? (ly:music-property music 'name) 'EventChord)
  42    (let ((note (car (ly:music-property music 'elements))))
  43      (set! (ly:music-property note 'articulations)
  44            (append (ly:music-property note 'articulations)
  45                    (list
  46                     (let ((obj (make-music 'FingeringEvent)))
  47                       (set! (ly:music-property obj 'tweaks)
  48                             (acons 'text
  49                                    (markup #:musicglyph glyph)
  50                                    (ly:music-property obj 'tweaks)))
  51                       obj)))))
  52    music))