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, version 3 or later: gnu.org/licenses     ;
   9 ;                                                                  ;
  10 ;------------------------------------------------------------------;
  11
  12
  13 (define (assoc-name alist name)
  14   (let ((res (assoc-ref alist name)))
  15     (if (not (string=? "" name))
  16         (if (char-lower-case? (car (string->list name)))
  17             (if (string? res) res name) name) name)))
  18
  19 (define (include-music name)
  20   (let ((mus (ly:parser-lookup parser (string->symbol name))))
  21     (if (ly:music? mus)
  22         (begin (if (ly:get-option 'debug-messages)
  23                   (ly:message "Loading music from ~a..." name))
  24                mus)
  25         (begin (if (ly:get-option 'debug-messages)
  26                   (ly:message "Variable ~a doesn't exist." name))
  27                (make-music 'Music 'void #t)))))
  28
  29 (define newStaff
  30   (define-music-function (parser location name) (string?)
  31     (let* ((name (assoc-name lang:instruments name))
  32            (mus-name (string-append current-part name))
  33            (music (ly:parser-lookup parser (string->symbol mus-name)))
  34            (instr (make-this-text name lang:instr-suffix))
  35            (short-instr (make-this-text name lang:short-instr-suffix))
  36            (lyrics (ly:parser-lookup parser
  37                                      (string->symbol
  38                                       (string-append mus-name lang:lyrics-suffix)))))
  39       (if (ly:get-option 'debug-messages) (ly:message "Loading music from ~a..." mus-name))
  40       (if (ly:music? music)
  41           #{ <<
  42              \new Staff \with {
  43                instrumentName = $instr
  44                shortInstrumentName = $short-instr
  45              }
  46              \new Voice = $name $music
  47                $(if (ly:music? lyrics)
  48                   #{ \new Lyrics \lyricsto $name $lyrics #})
  49           >> #}
  50           (begin (if (ly:get-option 'debug-messages)
  51                      (ly:message "Variable ~a doesn't exist." mus-name))
  52               (make-music 'Music 'void #t))))))
  53
  54 (define newLyrics
  55   (define-music-function (parser location name) (string?)
  56     (let* ((name (assoc-name lang:instruments name))
  57            (mus-name (string-append current-part name)))
  58       #{
  59         $(let* ((musiclist (list #{ {} #}))
  60                 (numlist (if (ly:get-option 'only-suffixed-varnames)
  61                             lang:numbers
  62                             (cons "" lang:numbers))))
  63           (map (lambda (x)
  64                   (let* ((lyr-name (string-append mus-name lang:lyrics-suffix
  65                                                   (string-capitalize x)))
  66                         (lyrics (ly:parser-lookup parser (string->symbol lyr-name))))
  67                     (if (ly:music? lyrics)
  68                         (append! musiclist (list
  69                                             #{ \new Lyrics \lyricsto $name $lyrics #})))))
  70                 lang:numbers)
  71           (make-simultaneous-music musiclist))
  72       #})))
  73
  74 (define newGrandStaff
  75   (define-music-function (parser location name) (string?)
  76     #{ \new GrandStaff
  77        $(let* ((name (assoc-name lang:instruments name))
  78                (mus-name (string-append current-part name))
  79                (musiclist (list #{ {} #}))
  80                (numlist (if (ly:get-option 'only-suffixed-varnames)
  81                             lang:numbers
  82                             (cons "" lang:numbers))))
  83           (map (lambda (x)
  84                   (let ((staff-name (string-append mus-name (string-capitalize x))))
  85                      (append! musiclist (list
  86                         #{ \newStaff $staff-name #}))))
  87             lang:numbers)
  88           (make-simultaneous-music musiclist))
  89      #} ))
  90
  91 (define newPianoStaff ;; TODO: include lyrics?
  92   (define-music-function (parser location name) (string?)
  93     (let* ((current-name (string-append current-part (assoc-name lang:instruments name)))
  94            (upper (string-append current-name (string-capitalize lang:upper-hand)))
  95            (lower (string-append current-name (string-capitalize lang:lower-hand)))
  96            (dynamics (string-append current-name lang:dynamics-suffix))
  97            (instr (make-this-text name lang:instr-suffix))
  98            (short-instr (make-this-text name lang:short-instr-suffix)))
  99     #{ \new PianoStaff \with {
 100          instrumentName = $instr
 101          shortInstrumentName = $short-instr
 102        }
 103      <<
 104          \new Staff = $lang:upper-hand $(include-music upper)
 105          \new Dynamics $(include-music dynamics)
 106          \new Staff = $lang:lower-hand $(include-music lower)
 107      >> #})))