lib/90-makescore.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 90-makescore.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 (define numbers #f)
  21 (define conf:structure numbers)
  22 (define *has-pagebreak* (make-parameter #f))
  23 ; This is admittedly ugly.
  24 (define pagebreak
  25   (make-music 'EventChord 'elements
  26     '((make-music 'LineBreakEvent 'break-permission 'force)
  27       (make-music 'PageBreakEvent 'break-permission 'force))
  28     'page-break-permission 'force
  29     'line-break-permission 'force
  30     'page-marker #t))
  31
  32 (define (alist-reverse alist)
  33   "Browse ALIST by looking for props, not by keys."
  34   (if (null? alist) '()
  35       (cons (cons (cdar alist) (caar alist))
  36             (alist-reverse (cdr alist)))))
  37
  38
  39 (define (ls-index str lst)
  40   "Where is STR in LST?"
  41   (- (length lst) (length (member str lst))))
  42
  43 (define (eval-skel file)
  44   "Load skeleton in FILE, and apply it to the
  45 current-part music."
  46   (eval-string (format #f
  47                        "(define-public (apply-skel arg instr-list)
  48       (*current-part* (car arg))
  49       (let* ((str (cdr arg))
  50              (key (assoc-ref (alist-reverse instr-list) str)))
  51         (if (string? key) #{ \\newStaff $key #}
  52             (begin
  53               (if (not (or (string=? \"\" str) (string=? lang:all)))
  54                   (ly:debug-message \"Unknown instrument variable;
  55   ---> please check your `make' argument.\"))
  56                  #{ ~a #}))))"
  57                        (read-file (open-input-file file)))))
  58
  59 (define output-redirect
  60 ;;   "Make sure that the PDF output will be placed in
  61 ;; the output-dir directory.  If book-filename has already
  62 ;; been defined by the user, just keep it, otherwise it
  63 ;; will be named after the score directory's name in scores/."
  64   (set! book-filename
  65         (let* ((orig-filename (if (defined-string? 'book-filename)
  66                                   book-filename
  67                                   (ly:parser-output-name parser)))
  68                (prefix (if (defined-string? 'conf:output-dir)
  69                            (string-append conf:output-dir "/")
  70                            #f))
  71                (new-filename (car (reverse
  72                                     (string-split (*current-score*) #\/)))))
  73           (if (not prefix)
  74               orig-filename
  75               (string-append prefix new-filename)))))
  76
  77 (define make
  78 ;;   "This is where the score is put together and all functions
  79 ;; are evaluated.  \make takes a string argument, that can be either:
  80 ;;   - the name of an instrument (to compile just a separate part)
  81 ;;   - the name of a section, or a separate piece
  82 ;;   - the name of a specific skeleton.
  83 ;; If ARG is an empty string or #"all" (or a localized equivalent),
  84 ;; then the whole score will be built.
  85 ;; Unrecognized string arguments are tolerated for now, but not recommended."
  86   (define-music-function (parser location arg) (string?)
  87     eval-conf
  88     eval-lang
  89     eval-macros
  90     eval-layout
  91     eval-theme
  92     (let* ((defined-structure (ly:parser-lookup parser 'structure))
  93            (struct (cond ((not defined-structure) conf:default-structure)
  94                          ((string? defined-structure) (list defined-structure))
  95                          ((list? defined-structure) defined-structure))))
  96       (if (string? (member arg struct))
  97           (set! struct arg))
  98
  99       (map (lambda (part)
 100          (if (string-suffix? "|" part)
 101              (let* ((num (ls-index part struct))
 102                     (trimmed (string-drop-right part 1)))
 103                (*has-pagebreak* #t)
 104                (set! part trimmed)
 105                (list-set! struct num trimmed)))
 106          (if (string-suffix? (or ".ly" ".ily") part)
 107              (let* ((regx (string-append "/" part "$"))
 108                     (file (car (find-files (*current-score*) regx))))
 109                 (ly:parser-include-string parser (format #f "\\include \"~a\"" file)))
 110              (let* ((skel-name (skel-file arg))
 111                     (skel-part (find-skel (string-append skel-name "-" part)))
 112                     (skel-num (find-skel (string-append skel-name "-" (number->string (ls-index part struct))))))
 113                (if (string? skel-part) (eval-skel skel-part)
 114                    (if (string? skel-num) (eval-skel skel-num)
 115                        (eval-skel (find-skel (skel-file skel-name)))))
 116
 117                (let* ((music (apply-skel (cons part arg) lang:instruments))
 118                       (score (scorify-music music parser))
 119                       (layout (ly:output-def-clone $defaultlayout))
 120                       (header (make-module))
 121                       (title (make-this-text part lang:title-suffix)))
 122                  (module-define! header 'piece title)
 123
 124                  (ly:score-set-header! score header)
 125                  (ly:score-add-output-def! score layout)
 126                  (if (*has-pagebreak*) (add-music parser pagebreak))
 127                  (add-score parser score)
 128                  (*has-timeline* #f)
 129                  (*has-pagebreak* #f)
 130                  output-redirect))))
 131
 132            struct)
 133       (make-music 'Music 'void #t))))
 134
 135 (include-ly (*current-score*))