;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2004--2005 Han-Wen Nienhuys <hanwen@cs.uu.nl>
(define-module (scm framework-tex)
#:export (output-framework-tex
(srfi srfi-13)
(lily))
+(define (output-formats)
+ (define formats (ly:output-formats))
+ (set! formats (completize-formats formats))
+ (if (member "ps" formats)
+ (set! formats (cons "dvi" formats)))
+ (if (member "dvi" formats)
+ (set! formats (cons "tex" formats)))
+
+ (uniq-list formats))
+
+(define framework-tex-module (current-module))
(define-public (sanitize-tex-string s)
(if (ly:get-option 'safe)
(regexp-substitute/global
#f "\\\\"
- (regexp-substitute/global #f "([{}])" s 'pre "\\" 1 'post )
+ (regexp-substitute/global #f "([{}])" s 'pre "\\" 1 'post)
'pre "$\\backslash$" 'post)
s))
(define (symbol->tex-key sym)
(regexp-substitute/global
- #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
+ #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
(define (tex-number-def prefix key number)
(string-append
"\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
-
(define-public (digits->letters str)
(regexp-substitute/global
#f "[-\\._]"
'pre ""
'post))
-
(define-public (tex-font-command-raw name magnification)
(string-append
"magfont"
- (string-encode-integer
- (hash name 1000000))
+ (digits->letters (format "~a" name))
"m"
(string-encode-integer
(inexact->exact (round (* 1000 magnification))))))
(tex-font-command-raw
(ly:font-file-name font) (ly:font-magnification font)))
-
(define (otf-font-load-command paper font)
- (let*
- ((sub-fonts (ly:font-sub-fonts font)))
-
+ (let* ((sub-fonts (ly:font-sub-fonts font)))
(string-append
(apply string-append
(map
(lambda (sub-name)
- (string-append
- "\\font\\" (tex-font-command-raw
- (symbol->string sub-name)
- (ly:font-magnification font))
- "=" (symbol->string sub-name)
- " scaled "
- (ly:number->string (inexact->exact
- (round (* 1000
- (ly:font-magnification font)
- (ly:paper-outputscale paper)))))
- "%\n"))
+ (format #f "\\font\\~a=~a scaled ~a%\n"
+ (tex-font-command-raw
+ sub-name (ly:font-magnification font))
+ sub-name
+ (ly:number->string
+ (inexact->exact
+ (round (* 1000
+ (ly:font-magnification font)
+ (ly:paper-outputscale paper)))))))
sub-fonts)))))
(define (simple-font-load-command paper font)
- (let* ((coding-alist (ly:font-encoding-alist font))
- (font-encoding (assoc-get 'output-name coding-alist)))
- (string-append
- "\\font\\lilypond" (tex-font-command font) "="
- (if (or (equal? (ly:font-encoding font) "cork-lm")
- ;; FIXME: encoding: FontSpecific for cork-lm
- (string-prefix? "lm" (ly:font-file-name font)))
- "cork-" "")
- (ly:font-file-name font)
- " scaled "
- (ly:number->string (inexact->exact
- (round (* 1000
- (ly:font-magnification font)
- (ly:paper-outputscale paper)))))
- "\n"
- "\\def\\" (tex-font-command font) "{%\n"
- ;; UGH. Should be handled via alist.
- (if (or (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
- (not font-encoding))
- " \\lilypondfontencoding{T1}"
- " ")
- "\\lilypond" (tex-font-command font)
- "}%\n")))
+ (format
+ "\\font\\~a=~a scaled ~a%\n"
+ (tex-font-command font)
+ (ly:font-file-name font)
+ (inexact->exact
+ (round (* 1000
+ (ly:font-magnification font)
+ (ly:paper-outputscale paper))))))
(define (font-load-command paper font)
(if (pair? (ly:font-sub-fonts font))
"}%\n\\vfill\n"
"}%\n\\vfill\n\\lilypondpagebreak\n")))
-(define-public (output-framework outputter book scopes fields basename )
- (let* ((paper (ly:paper-book-paper book))
+(define-public (output-framework basename book scopes fields)
+ (let* ((filename (format "~a.tex" basename))
+ (outputter (ly:make-paper-outputter filename "tex"))
+ (paper (ly:paper-book-paper book))
(pages (ly:paper-book-pages book))
(last-page (car (last-pair pages)))
(with-extents
(lambda (page)
(dump-page outputter page (eq? last-page page) with-extents))
pages)
- (ly:outputter-dump-string outputter "\\lilypondend\n")))
+ (ly:outputter-dump-string outputter "\\lilypondend\n")
+ (ly:outputter-close outputter)
+ (postprocess-output book framework-tex-module filename
+ (output-formats))))
(define (dump-line putter line last?)
(ly:outputter-dump-string
"}\\interscoreline\n")))
(define-public (output-classic-framework
- outputter book scopes fields basename)
- (let* ((paper (ly:paper-book-paper book))
+ basename book scopes fields)
+ (let* ((filename (format "~a.tex" basename))
+ (outputter (ly:make-paper-outputter filename "tex"))
+ (paper (ly:paper-book-paper book))
(lines (ly:paper-book-systems book))
(last-line (car (last-pair lines))))
(for-each
(for-each
(lambda (line) (dump-line outputter line (eq? line last-line))) lines)
- (ly:outputter-dump-string outputter "\\lilypondend\n")))
+ (ly:outputter-dump-string outputter "\\lilypondend\n")
+ (ly:outputter-close outputter)
+ (postprocess-output book framework-tex-module filename
+ (output-formats))
+ ))
(define-public (output-preview-framework
- outputter book scopes fields basename )
- (let* ((paper (ly:paper-book-paper book))
+ basename book scopes fields)
+ (let* ((filename (format "~a.tex" basename))
+ (outputter (ly:make-paper-outputter filename
+ "tex"))
+ (paper (ly:paper-book-paper book))
(lines (ly:paper-book-systems book))
(first-notes-index (list-index
(lambda (s) (not (ly:paper-system-title? s)))
(header-end)))
(for-each
- (lambda (l)
- (dump-line outputter l (not (ly:paper-system-title? l))))
+ (lambda (lst)
+ (dump-line outputter lst (not (ly:paper-system-title? lst))))
(take lines (1+ first-notes-index)))
- (ly:outputter-dump-string outputter "\\lilypondend\n")))
+ (ly:outputter-dump-string outputter "\\lilypondend\n")
+ (ly:outputter-close outputter)
+ (postprocess-output book framework-tex-module filename
+ (output-formats))
+
+))
(define-public (convert-to-pdf book name)
(let* ((defs (ly:paper-book-paper book))
(delete-file ps-name)))
(if (not (ly:get-option 'verbose))
(begin
- (format (current-error-port) (_ "Converting to `~a.ps'...") base)
+ (format (current-error-port) (_ "Converting to `~a'...")
+ (string-append base ".dvi"))
(newline (current-error-port))))
(ly:system cmd)))
(delete-file dvi-name)))
(if (not (ly:get-option 'verbose))
(begin
- (format (current-error-port) (_ "Converting to `~a.dvi'...") base)
+ (format (current-error-port) (_ "Converting to `~a'...")
+ (string-append base ".dvi"))
(newline (current-error-port))))
;; fixme: set in environment?