1 ;;;; framework-tex.scm --
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
7 (define-module (scm framework-tex)
8 #:export (output-framework-tex
9 output-classic-framework-tex))
11 (use-modules (ice-9 regex)
19 ;; what is bla supposed to do? It breaks the default output terribly:
21 ;; \def\lilypondpaperbla$\backslash${$\backslash$}{bla$\backslash${$\backslash$}}%
22 ;; \lyitem{089.5557}{-15.3109}{\hbox{\magfontUGQLomTVo{}bla$\backslash${$\backslash$}}}%
24 (define-public (sanitize-tex-string s)
25 (if (ly:get-option 'safe)
26 (regexp-substitute/global
28 (regexp-substitute/global #f "([{}])" "bla{}" 'pre "\\" 1 'post )
29 'pre "$\\backslash$" 'post)
32 (define (symbol->tex-key sym)
33 (regexp-substitute/global
34 #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
36 (define (tex-number-def prefix key number)
38 "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
40 (define-public (tex-font-command font)
43 (string-encode-integer
44 (hashq (ly:font-filename font) 1000000))
46 (string-encode-integer
47 (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
49 (define (font-load-command paper font)
50 (let* ((coding-alist (ly:font-encoding-alist font))
51 (font-encoding (assoc-get 'output-name coding-alist)))
53 "\\font\\lilypond" (tex-font-command font) "="
54 (ly:font-filename font)
56 (ly:number->string (inexact->exact
58 (ly:font-magnification font)
59 (ly:paper-outputscale paper)))))
61 "\\def\\" (tex-font-command font) "{%\n"
62 ;; UGH. Should be handled via alist.
63 (if (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
64 " \\lilypondfontencoding{T1}"
66 "\\lilypond" (tex-font-command font)
69 (define (define-fonts paper)
72 "\\def\\lilypondpaperunit{mm}%\n"
73 (tex-number-def "lilypondpaper" 'outputscale
74 (number->string (exact->inexact
75 (ly:paper-outputscale paper))))
76 (tex-string-def "lilypondpaper" 'papersize
77 (eval 'papersizename (ly:output-def-scope paper)))
79 (tex-string-def "lilypondpaper" 'inputencoding
80 (eval 'inputencoding (ly:output-def-scope paper)))
83 (map (lambda (x) (font-load-command paper x))
84 (ly:paper-fonts paper)))))
86 (define (header-to-file fn key val)
87 (set! key (symbol->string key))
88 (if (not (equal? "-" fn))
89 (set! fn (string-append fn "." key)))
91 (format (_ "Writing header field `~a' to `~a'...")
93 (if (equal? "-" fn) "<stdout>" fn))
97 (display val (open-file fn "w")))
98 (newline (current-error-port))
101 (define (output-scopes scopes fields basename)
102 (define (output-scope scope)
107 (let ((val (if (variable-bound? var) (variable-ref var) "")))
108 (if (and (memq sym fields) (string? val))
109 (header-to-file basename sym val))
112 (apply string-append (map output-scope scopes)))
114 (define (tex-string-def prefix key str)
115 (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
116 (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
117 (string-append "\\def\\" prefix (symbol->tex-key key)
118 "{" (sanitize-tex-string str) "}%\n")))
120 (define (header paper page-count classic?)
121 (let ((scale (ly:output-def-lookup paper 'outputscale))
122 (texpaper (string-append
123 (ly:output-def-lookup paper 'papersizename)
125 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
127 "% Generated by LilyPond "
128 (lilypond-version) "\n"
129 "% at " "time-stamp,FIXME" "\n"
131 (tex-string-def "lilypond" 'classic "1")
134 (if (ly:get-option 'safe)
139 "lilypondpaper" 'linewidth
140 (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
141 "\\def\\lilyponddocumentclassoptions{"
143 (if landscape? ",landscape" "")
146 "lilypondpaper" 'interscoreline
148 (* scale (ly:output-def-lookup paper 'interscoreline)))))))
152 "\\def\\scaletounit{ "
153 (number->string (cond
154 ((equal? (ly:unit) "mm") (/ 72.0 25.4))
155 ((equal? (ly:unit) "pt") (/ 72.0 72.27))
156 (else (error "unknown unit" (ly:unit)))))
158 "\\ifx\\lilypondstart\\undefined\n"
159 " \\input lilyponddefs\n"
162 "\\lilypondspecial\n"
163 "\\lilypondpostscript\n"))
165 (define (dump-page putter page last? with-extents?)
166 (ly:outputter-dump-string
168 (format "\\lybox{~a}{~a}{%\n"
170 (interval-start (ly:stencil-extent page X))
173 (- (interval-start (ly:stencil-extent page Y)))
175 (ly:outputter-dump-stencil putter page)
176 (ly:outputter-dump-string
180 "}%\n\\vfill\n\\lilypondpagebreak\n")))
182 (define-public (output-framework outputter book scopes fields basename )
183 (let* ((paper (ly:paper-book-paper book))
184 (pages (ly:paper-book-pages book))
185 (last-page (car (last-pair pages)))
187 (eq? #t (ly:output-def-lookup paper 'dump-extents))))
190 (ly:outputter-dump-string outputter x))
192 (header paper (length pages) #f)
195 (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
198 (dump-page outputter page (eq? last-page page) with-extents))
200 (ly:outputter-dump-string outputter "\\lilypondend\n")))
202 (define (dump-line putter line last?)
203 (ly:outputter-dump-string
205 (format "\\lybox{~a}{~a}{%\n"
207 (max 0 (interval-end (ly:paper-system-extent line X))))
209 (interval-length (ly:paper-system-extent line Y)))))
211 (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
212 (ly:outputter-dump-string
216 "}\\interscoreline\n")))
218 (define-public (output-classic-framework
219 outputter book scopes fields basename)
220 (let* ((paper (ly:paper-book-paper book))
221 (lines (ly:paper-book-systems book))
222 (last-line (car (last-pair lines))))
225 (ly:outputter-dump-string outputter x))
228 (header paper (length lines) #f)
229 "\\def\\lilypondclassic{1}%\n"
230 (output-scopes scopes fields basename)
235 (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
236 (ly:outputter-dump-string outputter "\\lilypondend\n")))
238 (define-public (output-preview-framework
239 outputter book scopes fields basename )
240 (let* ((paper (ly:paper-book-paper book))
241 (lines (ly:paper-book-systems book)))
244 (ly:outputter-dump-string outputter x))
247 (header paper (length lines) #f)
248 "\\def\\lilypondclassic{1}%\n"
249 (output-scopes scopes fields basename)
253 (dump-line outputter (car lines) #t)
254 (ly:outputter-dump-string outputter "\\lilypondend\n")))
256 (define-public (convert-to-pdf book name)
257 (let* ((defs (ly:paper-book-paper book))
258 (papersizename (ly:output-def-lookup defs 'papersizename)))
259 (postscript->pdf (if (string? papersizename) papersizename "a4")
261 (basename name ".tex")
264 (define-public (convert-to-png book name)
265 (let* ((defs (ly:paper-book-paper book))
266 (resolution (ly:output-def-lookup defs 'pngresolution)))
268 (if (number? resolution)
270 (ly:get-option 'resolution))
271 (string-append (basename name ".tex") ".ps"))))
275 ;; ugh - double check this. We are leaking
276 ;; untrusted (user-settable) info to a command-line
278 (define-public (convert-to-ps book name)
279 (let* ((paper (ly:paper-book-paper book))
280 (preview? (string-contains name ".preview"))
281 (papersizename (ly:output-def-lookup paper 'papersizename))
282 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
283 (base (basename name ".tex"))
284 (cmd (string-append "dvips "
287 (string-append " -t " papersizename))
291 " -u+ec-mftrace.map -u+lilypond.map -Ppdf "
296 (if (not (ly:get-option 'verbose))
298 (format (current-error-port) (_ "Converting to `~a.ps'...") base)
299 (newline (current-error-port))))
302 (define-public (convert-to-dvi book name)
303 (let* ((curr-extra-mem
305 (regexp-substitute/global
307 (ly:kpathsea-expand-variable "$extra_mem_top")
309 (base (basename name ".tex"))
311 "latex \\\\nonstopmode \\\\input " name
313 (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
314 (if (not (ly:get-option 'verbose))
316 (format (current-error-port) (_ "Converting to `~a.dvi'...") base)
317 (newline (current-error-port))))
319 ;; fixme: set in environment?
320 (if (ly:get-option 'safe)
321 (set! cmd (string-append "openout_any=p " cmd)))
325 (define-public (convert-to-tex book name)