lib/80-buildskel.scm

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