1 ;;;; framework-tex.scm -- structure for TeX output
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004--2006 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)
23 (define (output-formats)
24 (define formats (ly:output-formats))
25 (set! formats (completize-formats formats))
26 (if (member "ps" formats)
27 (set! formats (cons "dvi" formats)))
28 (if (member "dvi" formats)
29 (set! formats (cons "tex" formats)))
33 (define framework-tex-module (current-module))
34 (define-public (sanitize-tex-string s)
35 (if (ly:get-option 'safe)
36 (regexp-substitute/global
38 (regexp-substitute/global #f "([{}])" s 'pre "\\" 1 'post)
39 'pre "$\\backslash$" 'post)
42 (define (symbol->tex-key sym)
43 (regexp-substitute/global
44 #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
46 (define (tex-number-def prefix key number)
48 "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
50 (define-public (digits->letters str)
51 (regexp-substitute/global
53 (regexp-substitute/global
60 (+ (char->integer #\A)
61 (- (char->integer #\0))
62 (char->integer (string-ref (match:substring match 1) 0)))
68 (define-public (tex-font-command-raw name magnification)
71 (digits->letters (format "~a" name))
73 (string-encode-integer
74 (inexact->exact (round (* 1000 magnification))))))
76 (define-public (tex-font-command font)
78 (ly:font-file-name font) (ly:font-magnification font)))
80 (define (otf-font-load-command paper font)
81 (let* ((sub-fonts (ly:font-sub-fonts font)))
86 (format #f "\\font\\~a=~a scaled ~a%\n"
88 sub-name (ly:font-magnification font))
93 (ly:font-magnification font)
94 (ly:paper-outputscale paper)))))))
97 (define (simple-font-load-command paper font)
99 "\\font\\~a=~a scaled ~a%\n"
100 (tex-font-command font)
101 (ly:font-file-name font)
104 (ly:font-magnification font)
105 (ly:paper-outputscale paper))))))
107 (define (font-load-command paper font)
108 (if (pair? (ly:font-sub-fonts font))
109 (otf-font-load-command paper font)
110 (simple-font-load-command paper font)))
112 (define (define-fonts paper)
115 "\\def\\lilypondpaperunit{mm}%\n"
116 (tex-number-def "lilypondpaper" 'outputscale
117 (number->string (exact->inexact
118 (ly:paper-outputscale paper))))
119 (tex-string-def "lilypondpaper" 'papersize
120 (eval 'papersizename (ly:output-def-scope paper)))
122 (tex-string-def "lilypondpaper" 'inputencoding
123 (eval 'inputencoding (ly:output-def-scope paper)))
126 (map (lambda (x) (font-load-command paper x))
127 (ly:paper-fonts paper)))))
129 (define (tex-string-def prefix key str)
130 (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
131 (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
132 (string-append "\\def\\" prefix (symbol->tex-key key)
133 "{" (sanitize-tex-string str) "}%\n")))
135 (define (header paper page-count classic?)
136 (let ((scale (ly:output-def-lookup paper 'outputscale))
137 (texpaper (string-append
138 (ly:output-def-lookup paper 'papersizename)
140 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
142 "% Generated by LilyPond "
143 (lilypond-version) "\n"
144 "% at " "time-stamp,FIXME" "\n"
146 (tex-string-def "lilypond" 'classic "1")
149 (if (ly:get-option 'safe)
154 "lilypondpaper" 'linewidth
155 (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
156 "\\def\\lilyponddocumentclassoptions{"
157 (sanitize-tex-string texpaper)
158 (if landscape? ",landscape" "")
161 "lilypondpaper" 'interscoreline
163 (* scale (ly:output-def-lookup paper 'interscoreline)))))))
167 "\\def\\scaletounit{ "
168 (number->string lily-unit->bigpoint-factor)
170 "\\ifx\\lilypondstart\\undefined\n"
171 " \\input lilyponddefs\n"
174 "\\lilypondspecial\n"
175 "\\lilypondpostscript\n"))
177 (define (dump-page putter page last? with-extents?)
178 (ly:outputter-dump-string
180 (format "\\lybox{~a}{~a}{%\n"
182 (interval-start (ly:stencil-extent page X))
185 (- (interval-start (ly:stencil-extent page Y)))
187 (ly:outputter-dump-stencil putter page)
188 (ly:outputter-dump-string
192 "}%\n\\vfill\n\\lilypondpagebreak\n")))
194 (define-public (output-framework basename book scopes fields)
195 (let* ((filename (format "~a.tex" basename))
196 (outputter (ly:make-paper-outputter (open-file filename "wb") "tex"))
197 (paper (ly:paper-book-paper book))
198 (page-stencils (map page-stencil (ly:paper-book-pages book)))
199 (last-page (car (last-pair pages)))
201 (eq? #t (ly:output-def-lookup paper 'dump-extents))))
204 (ly:outputter-dump-string outputter x))
206 (header paper (length page-stencils) #f)
209 (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
212 (dump-page outputter page (eq? last-page page) with-extents))
214 (ly:outputter-dump-string outputter "\\lilypondend\n")
215 (ly:outputter-close outputter)
216 (postprocess-output book framework-tex-module filename
219 (define (dump-line putter line last?)
220 (ly:outputter-dump-string
222 (format "\\lybox{~a}{~a}{%\n"
224 (max 0 (interval-end (paper-system-extent line X))))
226 (interval-length (paper-system-extent line Y)))))
228 (ly:outputter-dump-stencil putter (paper-system-stencil line))
229 (ly:outputter-dump-string
233 "}\\interscoreline\n")))
235 (define-public (output-classic-framework
236 basename book scopes fields)
237 (let* ((filename (format "~a.tex" basename))
238 (outputter (ly:make-paper-outputter
239 (open-file filename "w") "tex"))
240 (paper (ly:paper-book-paper book))
241 (lines (ly:paper-book-systems book))
242 (last-line (car (last-pair lines))))
245 (ly:outputter-dump-string outputter x))
248 (header paper (length lines) #f)
249 "\\def\\lilypondclassic{1}%\n"
250 (output-scopes scopes fields basename)
255 (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
256 (ly:outputter-dump-string outputter "\\lilypondend\n")
257 (ly:outputter-close outputter)
258 (postprocess-output book framework-tex-module filename
262 (define-public (output-preview-framework
263 basename book scopes fields)
264 (let* ((filename (format "~a.tex" basename))
265 (outputter (ly:make-paper-outputter (open-file filename "wb")
267 (paper (ly:paper-book-paper book))
268 (lines (ly:paper-book-systems book))
269 (first-notes-index (list-index
270 (lambda (s) (not (ly:paper-system-title? s)))
275 (ly:outputter-dump-string outputter x))
279 (header paper (length lines) #f)
280 "\\def\\lilypondclassic{1}%\n"
281 (output-scopes scopes fields basename)
287 (dump-line outputter lst (not (ly:paper-system-title? lst))))
288 (take lines (1+ first-notes-index)))
289 (ly:outputter-dump-string outputter "\\lilypondend\n")
290 (ly:outputter-close outputter)
291 (postprocess-output book framework-tex-module filename
294 (define-public (convert-to-pdf book name)
295 (let* ((defs (ly:paper-book-paper book))
296 (papersizename (ly:output-def-lookup defs 'papersizename)))
297 (postscript->pdf (if (string? papersizename) papersizename "a4")
298 (string-append (basename name ".tex") ".ps"))))
300 (define-public (convert-to-png book name)
301 (let* ((defs (ly:paper-book-paper book))
302 (resolution (ly:output-def-lookup defs 'pngresolution))
303 (papersizename (ly:output-def-lookup defs 'papersizename)))
305 (if (number? resolution)
307 (ly:get-option 'resolution))
309 (if (string? papersizename)
313 (string-append (basename name ".tex") ".ps"))))
315 (define-public (convert-to-ps book name)
316 (let* ((paper (ly:paper-book-paper book))
317 (preview? (string-contains name ".preview"))
318 (papersizename (ly:output-def-lookup paper 'papersizename))
319 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
320 (base (basename name ".tex"))
321 (ps-name (format "~a.ps" base ".ps"))
322 (cmd (string-append "dvips"
327 ;; careful: papersizename is user-set.
328 (sanitize-command-option papersizename)
330 (if landscape? " -tlandscape" "")
331 (if (ly:kpathsea-find-file "lm.map")
333 (if (ly:kpathsea-find-file "ecrm10.pfa")
334 " -u+ec-mftrace.map" "")
335 " -u+lilypond.map -Ppdf" ""
338 (if (access? ps-name W_OK)
339 (delete-file ps-name))
340 (if (not (ly:get-option 'verbose))
342 (ly:message (_ "Converting to `~a'...") (string-append base ".ps"))
346 (define-public (convert-to-dvi book name)
347 (let* ((curr-extra-mem
349 (regexp-substitute/global
351 (ly:kpathsea-expand-variable "extra_mem_top")
353 (base (basename name ".tex"))
355 #f "latex \\\\nonstopmode \\\\input '~a'" name)))
357 ;; FIXME: latex 'foo bar' works, but \input 'foe bar' does not?
358 (if (string-index name (char-set #\space #\ht #\newline #\cr))
359 (ly:error (_"TeX file name must not contain whitespace: `~a'") name))
361 (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
362 (let ((dvi-name (string-append base ".dvi")))
363 (if (access? dvi-name W_OK)
364 (delete-file dvi-name)))
365 (if (not (ly:get-option 'verbose))
367 (ly:message (_ "Converting to `~a'...") (string-append base ".dvi"))
370 ;; FIXME: set in environment?
371 (if (ly:get-option 'safe)
372 (set! cmd (string-append "openout_any=p " cmd)))
376 (define-public (convert-to-tex book name)