bin/macros.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- macros.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 ; Input macros.
  21
  22 (load "../lib/libmusic.scm")
  23
  24 ;; TODO: use make-simple-function everywhere possible.
  25
  26 ;; Rhythm shortcuts -----------------------------------------------;
  27 (make-simple-function lang:tuplet-letter ; default: \t
  28                       #{ \times 2/3 $x #})
  29
  30 (make-simple-function lang:tuplet-letter-double ; \tt
  31                       #{ \times 4/5 $x #})
  32
  33 (make-simple-function lang:tuplet-letter-triple ; \ttt
  34                       #{ \times 4/6 $x #})
  35
  36 (make-simple-function lang:tuplet-letter-quad ; \tttt
  37                       #{ \times 4/7 $x #})
  38
  39 ;; Time signature equivalence
  40 (define equiv
  41  (define-music-function (parser location str) (string?)
  42    (let* ((mark-ev (make-music 'MarkEvent))
  43           (mark-ch (make-event-chord (list mark-ev)))
  44           (equiv-lst (string-split str #\= ))
  45           (before (parse-my-duration (car equiv-lst)))
  46           (after (parse-my-duration (cadr equiv-lst)))
  47           (before-mark (make-note-by-number-markup (car before) (cadr before) 1))
  48           (after-mark (make-note-by-number-markup (car after) (cadr after) 1))
  49           (equiv-mark
  50             (make-concat-markup
  51               (list
  52                 (make-general-align-markup Y DOWN
  53                   (make-smaller-markup before-mark))
  54                 (make-simple-markup " ")
  55                 (make-simple-markup "=")
  56                 (make-simple-markup " ")
  57                 (make-general-align-markup Y DOWN
  58                   (make-smaller-markup after-mark))
  59                 )))
  60           (mark-set (context-spec-music
  61               (make-property-set 'rehearsalMark equiv-mark)
  62               'Score)))
  63          (ly:music-set-property! mark-ev 'origin location)
  64          (ly:music-set-property! mark-ev 'label equiv-mark)
  65          mark-ch)))
  66
  67 ;; Auto octavation ------------------------------------------------;
  68 (define oct
  69   (define-music-function (parser location x) (ly:music?)
  70     (octavize x)))
  71
  72 ;; Polyphony shortcuts --------------------------------------------;
  73 (define pl
  74   (define-music-function (parser location one two)
  75     (ly:music? ly:music?)
  76     #{ << { \voiceTwo $one } \\ { \voiceOne $two } >> #}))
  77
  78 (staff-change-command lang:upper-hand) ;; depending on your input language:
  79 (staff-change-command lang:lower-hand) ;; \rh or \md etc. for switching staves.
  80
  81
  82 (define hideNote #{
  83 \once \override Dots #'transparent = ##t
  84 \once \override NoteHead #'transparent = ##t
  85 \once \override NoteHead #'no-ledgers = ##t
  86 \once \override Stem #'transparent = ##t
  87 \once \override Beam #'transparent = ##t
  88 \once \override Accidental #'transparent = ##t
  89 #})
  90
  91 (define hideNoteHead #{
  92 \once \override NoteHead #'transparent = ##t
  93 #})
  94
  95 (define hideNoteHeads
  96   (define-music-function (parser location x) (ly:music?)
  97   #{\override NoteHead #'transparent = ##t $x \revert NoteHead #'transparent #}))
  98
  99 (define noTuplet #{
 100 \once \override TupletBracket #'transparent = ##t
 101 \once \override TupletNumber #'transparent = ##t
 102 #})
 103
 104 (define oneStemDown #{
 105 \once \override Stem #'direction = #DOWN
 106 #})
 107
 108 (define oneStemUp #{
 109 \once \override Stem #'direction = #UP
 110 #})
 111
 112 (define graceNote #{
 113 %% Pasted from graceSettings definition in engraver-init.ly
 114 %% \once \override Stem #'direction = #UP
 115 \once \override Stem #'font-size = #-3
 116 \once \override NoteHead #'font-size = #-3
 117 \once \override TabNoteHead #'font-size = #-4
 118 \once \override Dots #'font-size = #-3
 119 \once \override Stem #'length-fraction = #0.8
 120 %% \once \override Stem #'no-stem-extend = ##t
 121 \once \override Beam #'beam-thickness = #0.384
 122 \once \override Beam #'length-fraction = #0.8
 123 \once \override Accidental #'font-size = #-4
 124 \once \override AccidentalCautionary #'font-size = #-4
 125 %% \once \override Slur #'direction = #DOWN
 126 \once \override Script #'font-size = #-3
 127 \once \override Fingering #'font-size = #-8
 128 \once \override StringNumber #'font-size = #-8
 129 #})
 130
 131 (define graceNotes
 132   (define-music-function (parser location x) (ly:music?)
 133   #{
 134 %% \override Stem #'direction = #UP %% Nope.
 135 \override Stem #'font-size = #-3
 136 \override NoteHead #'font-size = #-3
 137 \override TabNoteHead #'font-size = #-4
 138 \override Dots #'font-size = #-3
 139 \override Stem #'length-fraction = #0.8
 140 %% \override Stem #'no-stem-extend = ##t %% Not sure.
 141 \override Beam #'beam-thickness = #0.384
 142 \override Beam #'length-fraction = #0.8
 143 \override Accidental #'font-size = #-4
 144 \override AccidentalCautionary #'font-size = #-4
 145 %% \override Slur #'direction = #DOWN
 146 \override Script #'font-size = #-3
 147 \override Fingering #'font-size = #-8
 148 \override StringNumber #'font-size = #-8
 149 $x
 150 %% \revert Stem #'direction
 151 \revert Stem #'font-size
 152 \revert NoteHead #'font-size
 153 \revert TabNoteHead #'font-size
 154 \revert Dots #'font-size
 155 \revert Stem #'length-fraction
 156 %% \revert Stem #'no-stem-extend
 157 \revert Beam #'beam-thickness
 158 \revert Beam #'length-fraction
 159 \revert Accidental #'font-size
 160 \revert AccidentalCautionary #'font-size
 161 %% \revert Slur #'direction
 162 \revert Script #'font-size
 163 \revert Fingering #'font-size
 164 \revert StringNumber #'font-size
 165 #}))
 166
 167 (define lightBeam #{
 168 \once \override Beam #'beam-thickness = #0.384
 169 \once \override Beam #'gap = #0.5
 170 #})
 171
 172 (define lightBeams
 173   (define-music-function (parser location x) (ly:music?) #{
 174 \override Beam #'beam-thickness = #0.384
 175 \override Beam #'gap = #0.5
 176 $x
 177 \revert Beam #'beam-thickness
 178 \revert Beam #'gap
 179 #}))
 180
 181 (define longHairpin #{
 182 \once \override Hairpin #'to-barline = ##f
 183 #})
 184
 185 (define longHairpins
 186   (define-music-function (parser location x) (ly:music?) #{
 187 \override Hairpin #'to-barline = ##f
 188 $x
 189 \revert Hairpin #'to-barline
 190 #}))
 191
 192 (define whiteNote
 193   (define-music-function (parser location x) (ly:music?)
 194     (set! (ly:music-property x 'tweaks)
 195                                (acons 'duration-log 1
 196                                   (ly:music-property x 'tweaks)))
 197                          x))
 198
 199 (define blackNote
 200   (define-music-function (parser location x) (ly:music?)
 201     (set! (ly:music-property x 'tweaks)
 202        (acons 'before-line-breaking
 203               (lambda (grob)
 204                 (let ((dots (ly:grob-object grob 'dot)))
 205                   (ly:grob-set-property! grob 'duration-log 2)
 206                   (and (ly:grob? dots)
 207                        (ly:grob-set-property! dots 'dot-count 0))))
 208               (ly:music-property x 'tweaks)))
 209         x))
 210
 211 (define parlato
 212  (define-music-function (parser location x) (ly:music?)
 213 #{
 214 \override NoteHead #'style = #'cross
 215 $x
 216 \revert NoteHead #'style
 217 #}))
 218
 219 (define slap ;;TODO: adapt accordingly to stem direction?
 220  (define-music-function (parser location x) (ly:music?)
 221 #{
 222 \override NoteHead #'stencil = #ly:text-interface::print
 223 \override NoteHead #'text = \markup \musicglyph #"scripts.sforzato"
 224 \override NoteHead #'extra-offset = #'(0.1 . 0.0 )
 225 $x
 226 \revert NoteHead #'stencil
 227 \revert NoteHead #'text
 228 \revert NoteHead #'extra-offset
 229 #}))
 230
 231 (define harmoChord ;; FIXME: overly complicated.
 232  (define-music-function (parser location chord result) (ly:music? ly:music?)
 233  #{
 234 << \oneStemDown $chord \\ { \stemUp %FIXME: ties could look better.
 235 \override NoteHead #'stencil = #ly:text-interface::print
 236 \override NoteHead #'text = \markup { \null \musicglyph #"noteheads.s2"}
 237 \once \override NoteHead #'text = \markup {\null \override #'(direction . 1)
 238   \dir-column {\musicglyph #"noteheads.s2" \teeny \musicglyph #"eight"}}
 239 \override Stem #'stencil = ##f $result
 240 \revert Stem #'stencil \revert NoteHead #'stencil \stemNeutral } >> #}))
 241
 242 (define harmonics
 243  (define-music-function (parser location x) (ly:music?)
 244 #{
 245 \override Dots #'transparent = ##t
 246 \override Stem #'transparent = ##t
 247 \override Beam #'transparent = ##t
 248 \override NoteHead #'style = #'harmonic
 249 $x
 250 \revert NoteHead #'style
 251 \revert Beam #'transparent
 252 \revert Stem #'transparent
 253 \revert Dots #'transparent #}))
 254
 255 (define smart
 256  (define-music-function (parser location x) (ly:music?)
 257    (naturalize x)))
 258