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