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