lib/90-makescore.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- 90-makescore.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 (define numbers #f)
  13 (define current-part #f)
  14 (define conf:structure numbers)
  15
  16 (define-public (include-ly dir)
  17   "Include all LilyPond code found in DIR, recursively."
  18   (let ((ly-files (find-files dir ".i?ly$" #t)))
  19     (map (lambda (x)
  20            (if (string-ci=? conf:local-ly-score
  21                             (string-take-right x (string-length conf:local-ly-score)))
  22                (if (ly:get-option 'debug-messages)
  23                    (ly:message "Skipping local score file: ~a..." x))
  24                (ly:parser-include-string parser (format #f "\\include \"~a\"" x))))
  25          ly-files)))
  26
  27 (define (alist-reverse alist)
  28   (if (null? alist) '()
  29       (cons (cons (cdr (car alist)) (car (car alist)))
  30             (alist-reverse (cdr alist)))))
  31
  32 (define (ls-index str lst)
  33   (number->string (- (length lst) (length (member str lst)))))
  34
  35 (define (eval-skel file)
  36   (eval-string (format #f
  37    "(define-public (apply-skel arg instr-list)
  38       (set! current-part (car arg))
  39       (let* ((str (cdr arg))
  40              (key (assoc-ref (alist-reverse instr-list) str)))
  41         (if (string? key) #{ \\newStaff $key #}
  42             (begin
  43               (if (not (or (string=? \"\" str) (string=? lang:all)))
  44                   (if (ly:get-option 'debug-messages)
  45                       (ly:warning \"Unknown instrument variable;
  46   ---> please check your `make' argument.\")))
  47                  #{ ~a #}))))"
  48         (read-file (open-input-file file)))))
  49
  50 (define output-redirect
  51   (set! book-filename
  52     (let* ((orig-filename (if (defined-string? 'book-filename)
  53                               book-filename
  54                               (ly:parser-output-name parser)))
  55            (prefix (if (defined-string? 'conf:output-dir)
  56                        (string-append conf:output-dir "/")
  57                        #f))
  58            (new-filename (if (defined-string? 'scores)
  59                              (ly:parser-lookup parser 'scores)
  60                              orig-filename)))
  61       (if (not prefix)
  62           orig-filename
  63           (string-append prefix new-filename)))))
  64
  65 (define make
  66   (define-music-function (parser location arg) (string?)
  67     eval-conf
  68     eval-lang
  69     eval-macros
  70     (include-ly score-dir)
  71     (let* ((defined-structure (ly:parser-lookup parser 'structure))
  72            (struct (cond ((not defined-structure) conf:default-structure)
  73                          ((string? defined-structure) (list defined-structure))
  74                          ((list? defined-structure) defined-structure))))
  75       (if (string? (member arg struct))
  76           (set! struct arg))
  77     (map (lambda (part)
  78           (let* ((skel-name (if (string? (find-skel arg)) arg (ly:parser-lookup parser 'skel)))
  79                  (skel-part (find-skel (string-append skel-name "-" part)))
  80                  (skel-num (find-skel (string-append skel-name "-" (ls-index part struct)))))
  81             (if (string? skel-part) (eval-skel skel-part)
  82                   (if (string? skel-num) (eval-skel skel-num)
  83                       (eval-skel (find-skel skel-name))))
  84
  85             (let* ((music (apply-skel (cons part arg) lang:instruments))
  86                    (score (scorify-music music parser))
  87                    (layout (ly:output-def-clone $defaultlayout))
  88                    (header (make-module))
  89                    (title (make-this-text part lang:title-suffix)))
  90               (module-define! header 'piece title)
  91
  92               (ly:score-set-header! score header)
  93               (ly:score-add-output-def! score layout)
  94               (add-score parser score)
  95               output-redirect)))
  96
  97         struct)
  98     (make-music 'Music 'void #t))))