X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-tex.scm;h=5a602e4e489ec4f2d914b5ba5282f4f01d1e7f90;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=9661f3ec25364c1a343ee47a024c3db8a214b9e4;hpb=8ecf19521cf55ad4084a0a87ad6a26339431614f;p=lilypond.git diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm index 9661f3ec25..5a602e4e48 100644 --- a/scm/framework-tex.scm +++ b/scm/framework-tex.scm @@ -1,8 +1,8 @@ -;;;; framework-tex.scm -- +;;;; framework-tex.scm -- structure for TeX output ;;;; -;;;; source file of the GNU LilyPond music typesetter +;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004--2005 Han-Wen Nienhuys +;;;; (c) 2004--2008 Han-Wen Nienhuys (define-module (scm framework-tex) #:export (output-framework-tex @@ -10,17 +10,22 @@ (use-modules (ice-9 regex) (ice-9 string-fun) - (ice-9 format) + (scm page) + (scm paper-system) (guile) (srfi srfi-1) (srfi srfi-13) + (srfi srfi-14) + (scm kpathsea) (lily)) +(define format ergonomic-simple-format) + (define (output-formats) (define formats (ly:output-formats)) (set! formats (completize-formats formats)) (if (member "ps" formats) - (set! formats (cons "dvi" formats))) + (set! formats (cons "dvi" formats))) (if (member "dvi" formats) (set! formats (cons "tex" formats))) @@ -79,7 +84,7 @@ (apply string-append (map (lambda (sub-name) - (format #f "\\font\\~a=~a scaled ~a%\n" + (format "\\font\\~a=~a scaled ~a%\n" (tex-font-command-raw sub-name (ly:font-magnification font)) sub-name @@ -87,7 +92,7 @@ (inexact->exact (round (* 1000 (ly:font-magnification font) - (ly:paper-outputscale paper))))))) + (ly:paper-output-scale paper))))))) sub-fonts))))) (define (simple-font-load-command paper font) @@ -98,7 +103,7 @@ (inexact->exact (round (* 1000 (ly:font-magnification font) - (ly:paper-outputscale paper)))))) + (ly:paper-output-scale paper)))))) (define (font-load-command paper font) (if (pair? (ly:font-sub-fonts font)) @@ -109,14 +114,14 @@ (string-append ;; UGH. FIXME. "\\def\\lilypondpaperunit{mm}%\n" - (tex-number-def "lilypondpaper" 'outputscale + (tex-number-def "lilypondpaper" 'output-scale (number->string (exact->inexact - (ly:paper-outputscale paper)))) + (ly:paper-output-scale 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))) + (tex-string-def "lilypondpaper" 'input-encoding + (eval 'input-encoding (ly:output-def-scope paper))) (apply string-append (map (lambda (x) (font-load-command paper x)) @@ -129,7 +134,7 @@ "{" (sanitize-tex-string str) "}%\n"))) (define (header paper page-count classic?) - (let ((scale (ly:output-def-lookup paper 'outputscale)) + (let ((scale (ly:output-def-lookup paper 'output-scale)) (texpaper (string-append (ly:output-def-lookup paper 'papersizename) "paper")) @@ -147,24 +152,18 @@ "") (tex-string-def - "lilypondpaper" 'linewidth - (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth)))) + "lilypondpaper" 'line-width + (ly:number->string (* scale (ly:output-def-lookup paper 'line-width)))) "\\def\\lilyponddocumentclassoptions{" (sanitize-tex-string texpaper) (if landscape? ",landscape" "") "}%\n" - (tex-string-def - "lilypondpaper" 'interscoreline - (ly:number->string - (* scale (ly:output-def-lookup paper 'interscoreline))))))) + ))) (define (header-end) (string-append "\\def\\scaletounit{ " - (number->string (cond - ((equal? (ly:unit) "mm") (/ 72.0 25.4)) - ((equal? (ly:unit) "pt") (/ 72.0 72.27)) - (else (error "unknown unit" (ly:unit))))) + (number->string lily-unit->bigpoint-factor) " mul }%\n" "\\ifx\\lilypondstart\\undefined\n" " \\input lilyponddefs\n" @@ -192,9 +191,9 @@ (define-public (output-framework basename book scopes fields) (let* ((filename (format "~a.tex" basename)) - (outputter (ly:make-paper-outputter filename "tex")) + (outputter (ly:make-paper-outputter (open-file filename "wb") 'tex)) (paper (ly:paper-book-paper book)) - (pages (ly:paper-book-pages book)) + (page-stencils (map page-stencil (ly:paper-book-pages book))) (last-page (car (last-pair pages))) (with-extents (eq? #t (ly:output-def-lookup paper 'dump-extents)))) @@ -202,14 +201,14 @@ (lambda (x) (ly:outputter-dump-string outputter x)) (list - (header paper (length pages) #f) + (header paper (length page-stencils) #f) (define-fonts paper) (header-end))) (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n") (for-each (lambda (page) (dump-page outputter page (eq? last-page page) with-extents)) - pages) + page-stencils) (ly:outputter-dump-string outputter "\\lilypondend\n") (ly:outputter-close outputter) (postprocess-output book framework-tex-module filename @@ -220,11 +219,11 @@ putter (format "\\lybox{~a}{~a}{%\n" (ly:number->string - (max 0 (interval-end (ly:paper-system-extent line X)))) + (max 0 (interval-end (paper-system-extent line X)))) (ly:number->string - (interval-length (ly:paper-system-extent line Y))))) + (interval-length (paper-system-extent line Y))))) - (ly:outputter-dump-stencil putter (ly:paper-system-stencil line)) + (ly:outputter-dump-stencil putter (paper-system-stencil line)) (ly:outputter-dump-string putter (if last? @@ -234,7 +233,8 @@ (define-public (output-classic-framework basename book scopes fields) (let* ((filename (format "~a.tex" basename)) - (outputter (ly:make-paper-outputter filename "tex")) + (outputter (ly:make-paper-outputter + (open-file filename "w") 'tex)) (paper (ly:paper-book-paper book)) (lines (ly:paper-book-systems book)) (last-line (car (last-pair lines)))) @@ -260,8 +260,8 @@ (define-public (output-preview-framework basename book scopes fields) (let* ((filename (format "~a.tex" basename)) - (outputter (ly:make-paper-outputter filename - "tex")) + (outputter (ly:make-paper-outputter (open-file filename "wb") + 'tex)) (paper (ly:paper-book-paper book)) (lines (ly:paper-book-systems book)) (first-notes-index (list-index @@ -287,57 +287,62 @@ (ly:outputter-dump-string outputter "\\lilypondend\n") (ly:outputter-close outputter) (postprocess-output book framework-tex-module filename - (output-formats)) - -)) + (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")))) + (paper-width (ly:output-def-lookup defs 'paper-width)) + (paper-height (ly:output-def-lookup defs 'paper-height)) + (output-scale (ly:output-def-lookup defs 'output-scale))) + (postscript->pdf (* paper-width output-scale (/ (ly:bp 1))) + (* paper-height output-scale (/ (ly:bp 1))) + (string-append (dir-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))) + (paper-width (ly:output-def-lookup defs 'paper-width)) + (paper-height (ly:output-def-lookup defs 'paper-height)) + (output-scale (ly:output-def-lookup defs 'output-scale))) (postscript->png - (if (number? resolution) resolution (ly:get-option 'resolution)) - (if (string? papersizename) papersizename "a4") - (string-append (basename name ".tex") ".ps")))) + (if (number? resolution) + resolution + (ly:get-option 'resolution)) + + (* paper-width output-scale (/ (ly:bp 1))) + (* paper-height output-scale (/ (ly:bp 1))) + + (string-append (dir-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")) - (cmd (string-append "dvips " + (base (dir-basename name ".tex")) + (ps-name (format "~a.ps" base ".ps")) + (cmd (string-append "dvips" (if preview? - "-E " + " -E" (string-append - "-t" + " -t" ;; careful: papersizename is user-set. (sanitize-command-option papersizename) - " ")) - (if landscape? "-t landscape " "") + "")) + (if landscape? " -tlandscape" "") (if (ly:kpathsea-find-file "lm.map") - "-u+lm.map " "") + " -u+lm.map" "") (if (ly:kpathsea-find-file "ecrm10.pfa") - "-u+ec-mftrace.map " "") - "-u+lilypond.map -Ppdf " "" - base))) - (let ((ps-name (string-append base ".ps"))) - (if (access? ps-name W_OK) - (delete-file ps-name))) + " -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 ".dvi")) - (newline (current-error-port)))) + (ly:message (_ "Converting to `~a'...") (string-append base ".ps")) + (ly:progress "\n"))) (ly:system cmd))) (define-public (convert-to-dvi book name) @@ -345,22 +350,26 @@ (string->number (regexp-substitute/global #f " *%.*\n?" - (ly:kpathsea-expand-variable "$extra_mem_top") + (ly:kpathsea-expand-variable "extra_mem_top") 'pre "" 'post))) - (base (basename name ".tex")) - (cmd (string-append - "latex \\\\nonstopmode \\\\input " name))) + (base (dir-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)) + (ly:error (_"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)))) + (ly:message (_ "Converting to `~a'...") (string-append base ".dvi")) + (ly:progress "\n"))) - ;; fixme: set in environment? + ;; FIXME: set in environment? (if (ly:get-option 'safe) (set! cmd (string-append "openout_any=p " cmd))) @@ -368,3 +377,4 @@ (define-public (convert-to-tex book name) #t) +