1 ;;;; framework-tex.scm --
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004--2005 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 (define (output-formats)
20 (define formats (ly:output-formats))
21 (set! formats (completize-formats formats))
22 (if (member "ps" formats)
23 (set! formats (cons "dvi" formats)))
24 (if (member "dvi" formats)
25 (set! formats (cons "tex" formats)))
29 (define framework-tex-module (current-module))
30 (define-public (sanitize-tex-string s)
31 (if (ly:get-option 'safe)
32 (regexp-substitute/global
34 (regexp-substitute/global #f "([{}])" s 'pre "\\" 1 'post)
35 'pre "$\\backslash$" 'post)
38 (define (symbol->tex-key sym)
39 (regexp-substitute/global
40 #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
42 (define (tex-number-def prefix key number)
44 "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
46 (define-public (digits->letters str)
47 (regexp-substitute/global
49 (regexp-substitute/global
56 (+ (char->integer #\A)
57 (- (char->integer #\0))
58 (char->integer (string-ref (match:substring match 1) 0)))
64 (define-public (tex-font-command-raw name magnification)
67 (digits->letters (format "~a" name))
69 (string-encode-integer
70 (inexact->exact (round (* 1000 magnification))))))
72 (define-public (tex-font-command font)
74 (ly:font-file-name font) (ly:font-magnification font)))
76 (define (otf-font-load-command paper font)
77 (let* ((sub-fonts (ly:font-sub-fonts font)))
82 (format #f "\\font\\~a=~a scaled ~a%\n"
84 sub-name (ly:font-magnification font))
89 (ly:font-magnification font)
90 (ly:paper-outputscale paper)))))))
93 (define (simple-font-load-command paper font)
95 "\\font\\~a=~a scaled ~a%\n"
96 (tex-font-command font)
97 (ly:font-file-name font)
100 (ly:font-magnification font)
101 (ly:paper-outputscale paper))))))
103 (define (font-load-command paper font)
104 (if (pair? (ly:font-sub-fonts font))
105 (otf-font-load-command paper font)
106 (simple-font-load-command paper font)))
108 (define (define-fonts paper)
111 "\\def\\lilypondpaperunit{mm}%\n"
112 (tex-number-def "lilypondpaper" 'outputscale
113 (number->string (exact->inexact
114 (ly:paper-outputscale paper))))
115 (tex-string-def "lilypondpaper" 'papersize
116 (eval 'papersizename (ly:output-def-scope paper)))
118 (tex-string-def "lilypondpaper" 'inputencoding
119 (eval 'inputencoding (ly:output-def-scope paper)))
122 (map (lambda (x) (font-load-command paper x))
123 (ly:paper-fonts paper)))))
125 (define (tex-string-def prefix key str)
126 (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
127 (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
128 (string-append "\\def\\" prefix (symbol->tex-key key)
129 "{" (sanitize-tex-string str) "}%\n")))
131 (define (header paper page-count classic?)
132 (let ((scale (ly:output-def-lookup paper 'outputscale))
133 (texpaper (string-append
134 (ly:output-def-lookup paper 'papersizename)
136 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
138 "% Generated by LilyPond "
139 (lilypond-version) "\n"
140 "% at " "time-stamp,FIXME" "\n"
142 (tex-string-def "lilypond" 'classic "1")
145 (if (ly:get-option 'safe)
150 "lilypondpaper" 'linewidth
151 (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
152 "\\def\\lilyponddocumentclassoptions{"
153 (sanitize-tex-string texpaper)
154 (if landscape? ",landscape" "")
157 "lilypondpaper" 'interscoreline
159 (* scale (ly:output-def-lookup paper 'interscoreline)))))))
163 "\\def\\scaletounit{ "
164 (number->string (cond
165 ((equal? (ly:unit) "mm") (/ 72.0 25.4))
166 ((equal? (ly:unit) "pt") (/ 72.0 72.27))
167 (else (error "unknown unit" (ly:unit)))))
169 "\\ifx\\lilypondstart\\undefined\n"
170 " \\input lilyponddefs\n"
173 "\\lilypondspecial\n"
174 "\\lilypondpostscript\n"))
176 (define (dump-page putter page last? with-extents?)
177 (ly:outputter-dump-string
179 (format "\\lybox{~a}{~a}{%\n"
181 (interval-start (ly:stencil-extent page X))
184 (- (interval-start (ly:stencil-extent page Y)))
186 (ly:outputter-dump-stencil putter page)
187 (ly:outputter-dump-string
191 "}%\n\\vfill\n\\lilypondpagebreak\n")))
193 (define-public (output-framework basename book scopes fields)
194 (let* ((filename (format "~a.tex" basename))
195 (outputter (ly:make-paper-outputter filename "tex"))
196 (paper (ly:paper-book-paper book))
197 (pages (ly:paper-book-pages book))
198 (last-page (car (last-pair pages)))
200 (eq? #t (ly:output-def-lookup paper 'dump-extents))))
203 (ly:outputter-dump-string outputter x))
205 (header paper (length pages) #f)
208 (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
211 (dump-page outputter page (eq? last-page page) with-extents))
213 (ly:outputter-dump-string outputter "\\lilypondend\n")
214 (ly:outputter-close outputter)
215 (postprocess-output book framework-tex-module filename
218 (define (dump-line putter line last?)
219 (ly:outputter-dump-string
221 (format "\\lybox{~a}{~a}{%\n"
223 (max 0 (interval-end (ly:paper-system-extent line X))))
225 (interval-length (ly:paper-system-extent line Y)))))
227 (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
228 (ly:outputter-dump-string
232 "}\\interscoreline\n")))
234 (define-public (output-classic-framework
235 basename book scopes fields)
236 (let* ((filename (format "~a.tex" basename))
237 (outputter (ly:make-paper-outputter filename "tex"))
238 (paper (ly:paper-book-paper book))
239 (lines (ly:paper-book-systems book))
240 (last-line (car (last-pair lines))))
243 (ly:outputter-dump-string outputter x))
246 (header paper (length lines) #f)
247 "\\def\\lilypondclassic{1}%\n"
248 (output-scopes scopes fields basename)
253 (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
254 (ly:outputter-dump-string outputter "\\lilypondend\n")
255 (ly:outputter-close outputter)
256 (postprocess-output book framework-tex-module filename
260 (define-public (output-preview-framework
261 basename book scopes fields)
262 (let* ((filename (format "~a.tex" basename))
263 (outputter (ly:make-paper-outputter filename
265 (paper (ly:paper-book-paper book))
266 (lines (ly:paper-book-systems book))
267 (first-notes-index (list-index
268 (lambda (s) (not (ly:paper-system-title? s)))
273 (ly:outputter-dump-string outputter x))
277 (header paper (length lines) #f)
278 "\\def\\lilypondclassic{1}%\n"
279 (output-scopes scopes fields basename)
285 (dump-line outputter lst (not (ly:paper-system-title? lst))))
286 (take lines (1+ first-notes-index)))
287 (ly:outputter-dump-string outputter "\\lilypondend\n")
288 (ly:outputter-close outputter)
289 (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")
299 (basename name ".tex")
302 (define-public (convert-to-png book name)
303 (let* ((defs (ly:paper-book-paper book))
304 (resolution (ly:output-def-lookup defs 'pngresolution)))
306 (if (number? resolution)
308 (ly:get-option 'resolution))
309 (string-append (basename name ".tex") ".ps"))))
311 (define-public (convert-to-ps book name)
312 (let* ((paper (ly:paper-book-paper book))
313 (preview? (string-contains name ".preview"))
315 (papersizename (ly:output-def-lookup paper 'papersizename))
316 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
317 (base (basename name ".tex"))
318 (cmd (string-append "dvips "
323 ;; careful: papersizename is user-set.
324 (sanitize-command-option papersizename)
326 (if landscape? "-t landscape " "")
327 (if (ly:kpathsea-find-file "lm.map")
329 (if (ly:kpathsea-find-file "ecrm10.pfa")
330 "-u+ec-mftrace.map " "")
331 "-u+lilypond.map -Ppdf " ""
333 (let ((ps-name (string-append base ".ps")))
334 (if (access? ps-name W_OK)
335 (delete-file ps-name)))
336 (if (not (ly:get-option 'verbose))
338 (format (current-error-port) (_ "Converting to `~a'...")
339 (string-append base ".dvi"))
340 (newline (current-error-port))))
343 (define-public (convert-to-dvi book name)
344 (let* ((curr-extra-mem
346 (regexp-substitute/global
348 (ly:kpathsea-expand-variable "$extra_mem_top")
350 (base (basename name ".tex"))
352 "latex \\\\nonstopmode \\\\input " name)))
353 (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
354 (let ((dvi-name (string-append base ".dvi")))
355 (if (access? dvi-name W_OK)
356 (delete-file dvi-name)))
357 (if (not (ly:get-option 'verbose))
359 (format (current-error-port) (_ "Converting to `~a'...")
360 (string-append base ".dvi"))
361 (newline (current-error-port))))
363 ;; fixme: set in environment?
364 (if (ly:get-option 'safe)
365 (set! cmd (string-append "openout_any=p " cmd)))
369 (define-public (convert-to-tex book name)