(srfi srfi-13)
(lily))
-(define-public (sanitize-tex-string s) ;; todo: rename
+;; FIXME: rename
+;; what is bla supposed to do? It breaks the default output terribly:
+
+;; \def\lilypondpaperbla$\backslash${$\backslash$}{bla$\backslash${$\backslash$}}%
+;; \lyitem{089.5557}{-15.3109}{\hbox{\magfontUGQLomTVo{}bla$\backslash${$\backslash$}}}%
+;; --jcn
+(define-public (sanitize-tex-string s)
(if (ly:get-option 'safe)
(regexp-substitute/global #f "\\\\"
(regexp-substitute/global #f "([{}])" "bla{}" 'pre "\\" 1 'post )
(string-encode-integer
(inexact->exact (round (* 1000 (ly:font-magnification font)))))))
-(define (font-load-command bookpaper font)
- (string-append
- "\\font\\" (tex-font-command font) "="
- (ly:font-filename font)
- " scaled "
- (ly:number->string (inexact->exact
- (round (* 1000
- (ly:font-magnification font)
- (ly:bookpaper-outputscale bookpaper)))))
- "\n"))
+(define (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) "="
+ (ly:font-filename 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 (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
+ " \\lilypondfontencoding{T1}"
+ " ")
+ "\\lilypond" (tex-font-command font)
+ "}%\n"
+ )))
-(define (define-fonts bookpaper)
+(define (define-fonts paper)
(string-append
- "\\def\\lilypondpaperunit{mm}" ;; UGH. FIXME.
+ ;; UGH. FIXME.
+ "\\def\\lilypondpaperunit{mm}%\n"
(tex-number-def "lilypondpaper" 'outputscale
(number->string (exact->inexact
- (ly:bookpaper-outputscale bookpaper))))
+ (ly:paper-outputscale paper))))
(tex-string-def "lilypondpaper" 'papersize
- (eval 'papersize (ly:output-def-scope bookpaper)))
+ (eval 'papersizename (ly:output-def-scope paper)))
+ ;; paper/layout?
+ (tex-string-def "lilypondpaper" 'inputencoding
+ (eval 'inputencoding (ly:output-def-scope paper)))
(apply string-append
- (map (lambda (x) (font-load-command bookpaper x))
- (ly:bookpaper-fonts bookpaper)))))
+ (map (lambda (x) (font-load-command paper x))
+ (ly:paper-fonts paper)))))
(define (header-to-file fn key val)
(set! key (symbol->string key))
(if (not (equal? "-" fn))
(set! fn (string-append fn "." key)))
(display
- (format "Writing header field `~a' to `~a'..."
+ (format (_ "Writing header field `~a' to `~a'...")
key
- (if (equal? "-" fn) "<stdout>" fn)
- )
+ (if (equal? "-" fn) "<stdout>" fn))
(current-error-port))
(if (equal? fn "-")
(display val)
(display val (open-file fn "w")))
- (display "\n" (current-error-port))
+ (newline (current-error-port))
"")
(define (output-scopes scopes fields basename)
(string-append "\\def\\" prefix (symbol->tex-key key)
"{" (sanitize-tex-string str) "}%\n")))
-(define (header bookpaper page-count classic?)
- (let ((scale (ly:output-def-lookup bookpaper 'outputscale)))
-
+(define (header paper page-count classic?)
+ (let ((scale (ly:output-def-lookup paper 'outputscale))
+ (texpaper (string-append
+ (ly:output-def-lookup paper 'papersizename)
+ "paper"))
+ (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
+
(string-append
"% Generated by LilyPond "
(lilypond-version) "\n"
(tex-string-def "lilypond" 'classic "1")
"")
+ (if (ly:get-option 'safe)
+ "\\nofiles\n"
+ "")
+
(tex-string-def
"lilypondpaper" 'linewidth
- (ly:number->string (* scale (ly:output-def-lookup bookpaper 'linewidth))))
-
+ (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
+ "\\def\\lilyponddocumentclassoptions{"
+ texpaper
+ (if landscape? ",landscape" "")
+ "}%\n"
(tex-string-def
"lilypondpaper" 'interscoreline
(ly:number->string
- (* scale (ly:output-def-lookup bookpaper 'interscoreline)))))))
+ (* scale (ly:output-def-lookup paper 'interscoreline)))))))
(define (header-end)
(string-append
"\\ifx\\lilypondstart\\undefined\n"
" \\input lilyponddefs\n"
"\\fi\n"
- "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
"\\lilypondstart\n"
"\\lilypondspecial\n"
"\\lilypondpostscript\n"))
-(define (dump-page putter page last?)
+(define (dump-page putter page last? with-extents?)
(ly:outputter-dump-string
putter
- "\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n")
+ (format "\\vbox to ~a\\outputscale{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n"
+ (if with-extents?
+ (- (interval-start (ly:stencil-extent page Y)))
+ 0.0
+ )))
(ly:outputter-dump-stencil putter page)
(ly:outputter-dump-string
putter
"}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
(define-public (output-framework outputter book scopes fields basename )
- (let* ((bookpaper (ly:paper-book-book-paper book))
+ (let* ((paper (ly:paper-book-paper book))
(pages (ly:paper-book-pages book))
(last-page (car (last-pair pages)))
+ (with-extents
+ (eq? #t (ly:output-def-lookup paper 'dump-extents)))
)
(for-each
(lambda (x)
(ly:outputter-dump-string outputter x))
(list
- (header bookpaper (length pages) #f)
- (define-fonts bookpaper)
+ (header paper (length pages) #f)
+ (define-fonts paper)
(header-end)))
-
+ (ly:outputter-dump-string outputter "\\lilypondnopagebreak")
(for-each
- (lambda (page) (dump-page outputter page (eq? last-page page)))
+ (lambda (page) (dump-page outputter page (eq? last-page page) with-extents))
pages)
(ly:outputter-dump-string outputter "\\lilypondend\n")))
(ly:outputter-dump-string
putter
(string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
- (ly:number->string (ly:paper-system-extent line Y))
- "}{"))
+ (ly:number->string (interval-length (ly:paper-system-extent line Y)))
+ "}{%\n"))
(ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
(ly:outputter-dump-string
(define-public (output-classic-framework
outputter book scopes fields basename)
- (let* ((bookpaper (ly:paper-book-book-paper book))
- (lines (ly:paper-book-lines book))
+ (let* ((paper (ly:paper-book-paper book))
+ (lines (ly:paper-book-systems book))
(last-line (car (last-pair lines))))
(for-each
(lambda (x)
(ly:outputter-dump-string outputter x))
(list
;;FIXME
- (header bookpaper (length lines) #f)
+ (header paper (length lines) #f)
"\\def\\lilypondclassic{1}%\n"
(output-scopes scopes fields basename)
- (define-fonts bookpaper)
+ (define-fonts paper)
(header-end)))
(for-each
(define-public (output-preview-framework
outputter book scopes fields basename )
- (let* ((bookpaper (ly:paper-book-book-paper book))
- (lines (ly:paper-book-lines book)))
+ (let* ((paper (ly:paper-book-paper book))
+ (lines (ly:paper-book-systems book)))
(for-each
(lambda (x)
(ly:outputter-dump-string outputter x))
(list
;;FIXME
- (header "creator" "timestamp" bookpaper (length lines) #f)
+ (header paper (length lines) #f)
"\\def\\lilypondclassic{1}%\n"
(output-scopes scopes fields basename)
- (define-fonts bookpaper)
+ (define-fonts paper)
(header-end)))
(dump-line outputter (car lines) #t)
(define-public (convert-to-pdf book name)
- (let*
- ((defs (ly:paper-book-book-paper book))
- (size (ly:output-def-lookup defs 'papersize)))
+ (let* ((defs (ly:paper-book-paper book))
+ (papersizename (ly:output-def-lookup defs 'papersizename)))
- (postscript->pdf (if (string? size) size "a4")
- (string-append
- (basename name ".tex")
- ".ps")
- )))
+ (postscript->pdf (if (string? papersizename) papersizename "a4")
+ (string-append (basename name ".tex") ".ps"))))
(define-public (convert-to-png book name)
- (let*
- ((defs (ly:paper-book-book-paper book))
- (resolution (ly:output-def-lookup defs 'pngresolution)))
+ (let* ((defs (ly:paper-book-paper book))
+ (resolution (ly:output-def-lookup defs 'pngresolution)))
(postscript->png
(if (number? resolution) resolution 90)
- (string-append (basename name ".tex") ".ps")
- )))
+ (string-append (basename name ".tex") ".ps"))))
(define-public (convert-to-ps book name)
- (let*
- ((cmd (string-append "dvips -u+ec-mftrace.map -u+lilypond.map -Ppdf " (basename name ".tex"))))
-
- (display (format #f "invoking ~S" cmd))
+ (let* ((paper (ly:paper-book-paper book))
+ (papersizename (ly:output-def-lookup paper 'papersizename))
+ (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
+ (cmd (string-append "dvips -t " papersizename
+ (if landscape? " -t landscape " " ")
+ " -u+ec-mftrace.map -u+lilypond.map -Ppdf "
+ (basename name ".tex"))))
+
+ (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
+ (newline (current-error-port))
(system cmd)))
(define-public (convert-to-dvi book name)
- (let*
- ((cmd (string-append "latex " name)))
-
- (display (format #f "invoking ~S\n" cmd))
+ (let* ((curr-extra-mem (string->number
+ (regexp-substitute/global
+ #f " *%.*\n?"
+ (ly:kpathsea-expand-variable "$extra_mem_top")
+ 'pre "" 'post)))
+ (cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
+
+ (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
+ (newline (current-error-port))
+ (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
+ (newline (current-error-port))
+
+ ;; fixme: set in environment?
+ (if (ly:get-option 'safe)
+ (set! cmd (string-append "openout_any=p " cmd)))
+
(system cmd)))
(define-public (convert-to-tex book name)
projects / lilypond.git / blobdiff