X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-tex.scm;h=3674054c6822b02c7c216bc41b27e4b5c486e86f;hb=0358e5f9f5e937ee39ce35c60da2283858b60cfa;hp=23a64ee2e8922a8b5ee5b0c181458e780a7dac7d;hpb=167dbf0b9730a336907db36be6add1895d29eaf8;p=lilypond.git diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm index 23a64ee2e8..3674054c68 100644 --- a/scm/framework-tex.scm +++ b/scm/framework-tex.scm @@ -2,62 +2,126 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004 Han-Wen Nienhuys +;;;; (c) 2004--2005 Han-Wen Nienhuys -(define-module (scm framework-tex)) +(define-module (scm framework-tex) + #:export (output-framework-tex + output-classic-framework-tex)) (use-modules (ice-9 regex) (ice-9 string-fun) (ice-9 format) (guile) + (srfi srfi-1) (srfi srfi-13) - (scm output-tex) + (srfi srfi-14) (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))) -(define (define-fonts bookpaper) + (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) + 'pre "$\\backslash$" 'post) + s)) + +(define (symbol->tex-key sym) + (regexp-substitute/global + #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 "[-\\._]" + (regexp-substitute/global + #f "([0-9])" str + 'pre + (lambda (match) + (make-string + 1 + (integer->char + (+ (char->integer #\A) + (- (char->integer #\0)) + (char->integer (string-ref (match:substring match 1) 0))) + ))) + 'post) + 'pre "" + 'post)) + +(define-public (tex-font-command-raw name magnification) + (string-append + "magfont" + (digits->letters (format "~a" name)) + "m" + (string-encode-integer + (inexact->exact (round (* 1000 magnification)))))) + +(define-public (tex-font-command font) + (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))) + (string-append + (apply string-append + (map + (lambda (sub-name) + (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) + (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)) + (otf-font-load-command paper font) + (simple-font-load-command paper font))) + +(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)))) - (tex-string-def "lilypondpapersize" 'papersize - (eval 'papersize (ly:output-def-scope bookpaper))) + (ly:paper-outputscale paper)))) + (tex-string-def "lilypondpaper" 'papersize + (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))))) - -(define-public (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'..." - key - (if (equal? "-" fn) "" fn) - ) - (current-error-port)) - (if (equal? fn "-") - (display val) - (display val (open-file fn "w"))) - (display "\n" (current-error-port)) - "") - -(define (output-scopes scopes fields basename) - (define (output-scope scope) - (apply - string-append - (module-map - (lambda (sym var) - (let ((val (if (variable-bound? var) (variable-ref var) "")) - ) - - (if (and (memq sym fields) (string? val)) - (header-to-file basename sym val)) - "")) - scope))) - (apply string-append (map output-scope scopes))) + (map (lambda (x) (font-load-command paper x)) + (ly:paper-fonts paper))))) (define (tex-string-def prefix key str) (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str))) @@ -65,24 +129,35 @@ (string-append "\\def\\" prefix (symbol->tex-key key) "{" (sanitize-tex-string str) "}%\n"))) -(define (header creator time-stamp 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 " creator "\n" - "% at " time-stamp "\n" + "% Generated by LilyPond " + (lilypond-version) "\n" + "% at " "time-stamp,FIXME" "\n" (if classic? (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{" + (sanitize-tex-string 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 @@ -95,66 +170,209 @@ "\\ifx\\lilypondstart\\undefined\n" " \\input lilyponddefs\n" "\\fi\n" - "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n" "\\lilypondstart\n" "\\lilypondspecial\n" "\\lilypondpostscript\n")) -(define (dump-page putter page) +(define (dump-page putter page last? with-extents?) (ly:outputter-dump-string putter - "\n\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n") - (ly:outputter-dump-stencil putter (ly:page-stencil page)) + (format "\\lybox{~a}{~a}{%\n" + (if with-extents? + (interval-start (ly:stencil-extent page X)) + 0.0) + (if with-extents? + (- (interval-start (ly:stencil-extent page Y))) + 0.0))) + (ly:outputter-dump-stencil putter page) (ly:outputter-dump-string putter - (if (ly:page-last? page) - "}\\vss\n}\n\\vfill\n" - "}\\vss\n}\n\\vfill\\lilypondpagebreak\n"))) + (if last? + "}%\n\\vfill\n" + "}%\n\\vfill\n\\lilypondpagebreak\n"))) -(define-public (output-framework-tex outputter book scopes fields basename) - (let* ((bookpaper (ly:paper-book-book-paper book)) - (pages (ly:paper-book-pages 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 + (eq? #t (ly:output-def-lookup paper 'dump-extents)))) (for-each (lambda (x) (ly:outputter-dump-string outputter x)) (list - (header "creator" "timestamp" bookpaper (length pages) #f) - (define-fonts bookpaper) + (header paper (length pages) #f) + (define-fonts paper) (header-end))) - (for-each (lambda (page) (dump-page outputter page)) pages) - (ly:outputter-dump-string outputter "\\lilypondend\n"))) + (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n") + (for-each + (lambda (page) + (dump-page outputter page (eq? last-page page) with-extents)) + pages) + (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 putter - (string-append "\\leavevmode\n\\lybox{0}{0}{0}{" - (ly:number->string (ly:paper-line-extent line Y)) - "}{")) + (format "\\lybox{~a}{~a}{%\n" + (ly:number->string + (max 0 (interval-end (ly:paper-system-extent line X)))) + (ly:number->string + (interval-length (ly:paper-system-extent line Y))))) - (ly:outputter-dump-stencil putter (ly:paper-line-stencil line)) + (ly:outputter-dump-stencil putter (ly:paper-system-stencil line)) (ly:outputter-dump-string putter (if last? "}%\n" "}\\interscoreline\n"))) -(define-public (output-classic-framework-tex - outputter book scopes fields basename) - (let* ((bookpaper (ly:paper-book-book-paper book)) - (lines (ly:paper-book-lines book)) +(define-public (output-classic-framework + 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 (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))) (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 + 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))) + lines))) + + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (list + + ;;FIXME + (header paper (length lines) #f) + "\\def\\lilypondclassic{1}%\n" + (output-scopes scopes fields basename) + (define-fonts paper) + (header-end))) + + (for-each + (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-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)) + (papersizename (ly:output-def-lookup defs 'papersizename))) + (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-paper book)) + (resolution (ly:output-def-lookup defs 'pngresolution)) + (papersizename (ly:output-def-lookup defs 'papersizename))) + (postscript->png + (if (number? resolution) resolution (ly:get-option 'resolution)) + (if (string? papersizename) papersizename "a4") + (string-append (basename name ".tex") ".ps")))) + +(define-public (convert-to-ps book name) + (let* ((paper (ly:paper-book-paper book)) + (preview? (string-contains name ".preview")) + (papersizename (ly:output-def-lookup paper 'papersizename)) + (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))) + (base (basename name ".tex")) + (ps-name (format "~a.ps" base ".ps")) + (cmd (string-append "dvips" + (if preview? + " -E" + (string-append + " -t" + ;; careful: papersizename is user-set. + (sanitize-command-option papersizename) + "")) + (if landscape? " -tlandscape" "") + (if (ly:kpathsea-find-file "lm.map") + " -u+lm.map" "") + (if (ly:kpathsea-find-file "ecrm10.pfa") + " -u+ec-mftrace.map" "") + " -u+lilypond.map -Ppdf" "" + " -o" ps-name + " " base))) + (if (access? ps-name W_OK) + (delete-file ps-name)) + (if (not (ly:get-option 'verbose)) + (begin + (format (current-error-port) + (_ "Converting to `~a'...") (string-append base ".ps")) + (newline (current-error-port)))) + (ly:system cmd))) + +(define-public (convert-to-dvi book name) + (let* ((curr-extra-mem + (string->number + (regexp-substitute/global + #f " *%.*\n?" + (ly:kpathsea-expand-variable "$extra_mem_top") + 'pre "" 'post))) + (base (basename name ".tex")) + (cmd (format + #f "latex \\\\nonstopmode \\\\input '~a'" name))) + + ;; FIXME: latex 'foo bar' works, but \input 'foe bar' does not? + (if (string-index name (char-set #\space #\ht #\newline #\cr)) + (error (format + #f + (_"TeX file name must not contain whitespace: `~a'") name))) + + (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000))) + (let ((dvi-name (string-append base ".dvi"))) + (if (access? dvi-name W_OK) + (delete-file dvi-name))) + (if (not (ly:get-option 'verbose)) + (begin + (format (current-error-port) (_ "Converting to `~a'...") + (string-append base ".dvi")) + (newline (current-error-port)))) + + ;; FIXME: set in environment? + (if (ly:get-option 'safe) + (set! cmd (string-append "openout_any=p " cmd))) + + (ly:system cmd))) +(define-public (convert-to-tex book name) + #t)