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