lib/80-buildskel.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 80-buildskel.scm                                   ;
   3 ;                                                                  ;
   4 ; (c) 2008-2010 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
  21 (define (assoc-name alist name)
  22   "If NAME begins with a lower case letter, then
  23 try to find a matching entry in ALIST."
  24   (let ((res (assoc-ref alist name)))
  25     (if (not (string=? "" name))
  26         (if (char-lower-case? (car (string->list name)))
  27             (if (string? res) res name) name) name)))
  28
  29 (define (include-music name)
  30   "Turn NAME into a music expression if one exists."
  31   (let ((mus (ly:parser-lookup parser (string->symbol name))))
  32     (if (ly:music? mus)
  33         (begin (ly:debug-message "Loading music from ~a..." name)
  34                mus)
  35         (begin (ly:debug-message "Variable ~a doesn't exist." name)
  36                (make-music 'Music 'void #t)))))
  37
  38 (define (make-this-text name suffix)
  39   "Associate NAME with SUFFIX, and check if a suitable
  40 markup exists."
  41   (let ((mark (ly:parser-lookup parser
  42                                 (string->symbol
  43                                  (string-append name suffix)))))
  44     (if (markup? mark) mark
  45         (begin
  46           (ly:debug-message "No text found in ~a~a" name suffix)
  47           (if (ly:get-option 'use-variable-names)
  48               (regexp-substitute/global #f "[A-Z]" name 'pre " "0 'post)
  49               point-stencil)))))
  50
  51 (define newVoice
  52   ;;   "If NAME matches a defined music expression, then
  53   ;; create a Voice for it.  If a matching timeline can be
  54   ;; found, try and squash it as well."
  55   (define-music-function (parser location name) (string?)
  56     (let* ((current-name (string-append current-part name))
  57            (music (ly:parser-lookup parser (string->symbol current-name)))
  58            (part-timeline (ly:parser-lookup parser
  59                                             (string->symbol
  60                                              (string-append current-part lang:timeline-suffix))))
  61            (instr-timeline (ly:parser-lookup parser
  62                                              (string->symbol
  63                                               (string-append current-name lang:timeline-suffix)))))
  64       (ly:debug-message "Loading music from ~a..." current-name)
  65       (if (ly:music? music)
  66           #{ \new Voice = $name
  67              <<
  68                $music
  69                $(if (ly:music? instr-timeline)
  70                     instr-timeline
  71                     (if (ly:music? part-timeline)
  72                         part-timeline))
  73              >>
  74           #}
  75           (begin (ly:debug-message "Variable ~a doesn't exist." current-name)
  76                  (make-music 'Music 'void #t))))))
  77
  78 (define newDynamics
  79   ;;   "If NAME matches an existing music expression, then
  80   ;; create a Dynamics context for it.  If NAME includes
  81   ;; several names separated with spaces, then look for
  82   ;; music expressions matching each available names."
  83   (define-music-function (parser location name) (string?)
  84     (let ((str-list (if (string-any #\sp name)
  85                         (string-split name #\sp)
  86                         (list name)))
  87           (ret-list '()))
  88       (map (lambda (x)
  89              (let* ((m (ly:parser-lookup parser
  90                                         (string->symbol x))))
  91                (if (ly:music? m)
  92                    (set! ret-list
  93                          (append ret-list
  94                                  (list
  95                                    #{\context Dynamics = $name
  96                                       \filterDynamics $m
  97                                    #}))))))
  98            str-list)
  99       (if (not (null? ret-list))
 100           (make-simultaneous-music ret-list)
 101           (make-music 'Music 'void #t)))))
 102
 103 (define newStaff
 104   ;;   "If NAME matches a defined music expression, then
 105   ;; create a Staff for it.  Then find and include any
 106   ;; instrumentName or Lyrics expression that could match
 107   ;; this staff (using appropriate suffixes)."
 108   (define-music-function (parser location name) (string?)
 109     (let* ((name (assoc-name lang:instruments name))
 110            (current-name (string-append current-part name))
 111            (music (ly:parser-lookup parser (string->symbol current-name)))
 112            (instr (make-this-text name lang:instr-suffix))
 113            (short-instr (make-this-text name lang:short-instr-suffix))
 114            (lyrics (ly:parser-lookup parser
 115                                      (string->symbol
 116                                       (string-append current-name lang:lyrics-suffix)))))
 117       (if (ly:music? music)
 118           #{ <<
 119              \new Staff \with {
 120                instrumentName = $instr
 121                shortInstrumentName = $short-instr
 122              }
 123              \newVoice $name
 124                $(if (ly:music? lyrics)
 125                   #{ \new Lyrics \lyricsto $name $lyrics #})
 126           >> #}
 127           (begin (ly:debug-message "Variable ~a doesn't exist." current-name)
 128               (make-music 'Music 'void #t))))))
 129
 130 (define newLyrics
 131 ;;   "From the given NAME, try and find as many Lyrics
 132 ;; expressions as possible, using the lyrics suffix and
 133 ;; (unless 'only-suffixed-varnames is set) numbers as
 134 ;; suffixes: in case there would be multiple verses, etc.
 135 ;; Create Lyrics contexts accordingly."
 136   (define-music-function (parser location name) (string?)
 137     (let* ((name (assoc-name lang:instruments name))
 138            (current-name (string-append current-part name)))
 139       #{
 140         $(let* ((musiclist (list #{ {} #}))
 141                 (numlist (if (ly:get-option 'only-suffixed-varnames)
 142                             lang:numbers
 143                             (cons "" lang:numbers))))
 144           (map (lambda (x)
 145                   (let* ((lyr-name (string-append current-name lang:lyrics-suffix
 146                                                   (string-capitalize x)))
 147                         (lyrics (ly:parser-lookup parser (string->symbol lyr-name))))
 148                     (if (ly:music? lyrics)
 149                         (append! musiclist (list
 150                                             #{ \new Lyrics \lyricsto $name $lyrics #})))))
 151                 lang:numbers)
 152           (make-simultaneous-music musiclist))
 153       #})))
 154
 155 (define newGrandStaff
 156 ;;   "From the given NAME, try and find as many instrument
 157 ;; parts as possible, by appending numbers as suffixes.  Then
 158 ;; create a GrandStaff containing staves for e.g.
 159 ;; \fluteOne, \fluteTwo, \fluteThree etc. as needed."
 160   (define-music-function (parser location name) (string?)
 161     #{ \new GrandStaff
 162        $(let* ((name (assoc-name lang:instruments name))
 163                (musiclist (list #{ {} #}))
 164                (numlist (if (ly:get-option 'only-suffixed-varnames)
 165                             lang:numbers
 166                             (cons "" lang:numbers))))
 167           (map (lambda (x)
 168                   (let ((staff-name (string-append current-part name (string-capitalize x))))
 169                      (append! musiclist (list
 170                         #{ \newStaff $staff-name #}))))
 171             lang:numbers)
 172           (make-simultaneous-music musiclist))
 173      #}))
 174
 175 (define newPianoStaff ;; TODO: include lyrics?
 176 ;;   "Create a PianoStaff with two staves named after
 177 ;; the appropriate upper-hand/lower-hand localized definitions,
 178 ;; that are also used in the variables as suffixes (e.g.
 179 ;; \PianoRh, \PianoLh).  This also allows for localized
 180 ;; Staff-\changing shorthands.  If a suitable Dynamics
 181 ;; expression is found, it will also be included accordingly;
 182 ;; else if automatic-piano-dynamics is set, a Dynamics context
 183 ;; will be created using dynamics from either staff (or both)."
 184   (define-music-function (parser location name) (string?)
 185     (let* ((name (assoc-name lang:instruments name))
 186            (upper (string-append name (string-capitalize lang:upper-hand)))
 187            (lower (string-append name (string-capitalize lang:lower-hand)))
 188            (dynamics (string-append current-part name lang:dynamics-suffix))
 189            (dynvar (ly:parser-lookup parser (string->symbol dynamics)))
 190            (instr (make-this-text name lang:instr-suffix))
 191            (short-instr (make-this-text name lang:short-instr-suffix)))
 192       ;; requires removeDynamics, defined in libmusic.scm
 193       ;; (which should have been loaded by now, since macros need it).
 194     #{ \new PianoStaff \with {
 195          instrumentName = $instr
 196          shortInstrumentName = $short-instr
 197        } <<
 198          \new Staff = $lang:upper-hand
 199            \removeDynamics \newVoice $upper
 200          \newDynamics $(if (ly:music? dynvar)
 201                            dynamics
 202                            (string-append upper " " lower))
 203          \new Staff = $lang:lower-hand
 204            \removeDynamics \newVoice $lower
 205      >>#})))