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