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)
20 (define (output-formats)
21 (define formats (ly:output-formats))
22 (set! formats (completize-formats formats))
23 (if (member "ps" formats)
24 (set! formats (cons "dvi" formats)))
25 (if (member "dvi" formats)
26 (set! formats (cons "tex" formats)))
30 (define framework-tex-module (current-module))
31 (define-public (sanitize-tex-string s)
32 (if (ly:get-option 'safe)
33 (regexp-substitute/global
35 (regexp-substitute/global #f "([{}])" s 'pre "\\" 1 'post)
36 'pre "$\\backslash$" 'post)
39 (define (symbol->tex-key sym)
40 (regexp-substitute/global
41 #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
43 (define (tex-number-def prefix key number)
45 "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
47 (define-public (digits->letters str)
48 (regexp-substitute/global
50 (regexp-substitute/global
57 (+ (char->integer #\A)
58 (- (char->integer #\0))
59 (char->integer (string-ref (match:substring match 1) 0)))
65 (define-public (tex-font-command-raw name magnification)
68 (digits->letters (format "~a" name))
70 (string-encode-integer
71 (inexact->exact (round (* 1000 magnification))))))
73 (define-public (tex-font-command font)
75 (ly:font-file-name font) (ly:font-magnification font)))
77 (define (otf-font-load-command paper font)
78 (let* ((sub-fonts (ly:font-sub-fonts font)))
83 (format #f "\\font\\~a=~a scaled ~a%\n"
85 sub-name (ly:font-magnification font))
90 (ly:font-magnification font)
91 (ly:paper-outputscale paper)))))))
94 (define (simple-font-load-command paper font)
96 "\\font\\~a=~a scaled ~a%\n"
97 (tex-font-command font)
98 (ly:font-file-name font)
101 (ly:font-magnification font)
102 (ly:paper-outputscale paper))))))
104 (define (font-load-command paper font)
105 (if (pair? (ly:font-sub-fonts font))
106 (otf-font-load-command paper font)
107 (simple-font-load-command paper font)))
109 (define (define-fonts paper)
112 "\\def\\lilypondpaperunit{mm}%\n"
113 (tex-number-def "lilypondpaper" 'outputscale
114 (number->string (exact->inexact
115 (ly:paper-outputscale paper))))
116 (tex-string-def "lilypondpaper" 'papersize
117 (eval 'papersizename (ly:output-def-scope paper)))
119 (tex-string-def "lilypondpaper" 'inputencoding
120 (eval 'inputencoding (ly:output-def-scope paper)))
123 (map (lambda (x) (font-load-command paper x))
124 (ly:paper-fonts paper)))))
126 (define (tex-string-def prefix key str)
127 (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
128 (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
129 (string-append "\\def\\" prefix (symbol->tex-key key)
130 "{" (sanitize-tex-string str) "}%\n")))
132 (define (header paper page-count classic?)
133 (let ((scale (ly:output-def-lookup paper 'outputscale))
134 (texpaper (string-append
135 (ly:output-def-lookup paper 'papersizename)
137 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
139 "% Generated by LilyPond "
140 (lilypond-version) "\n"
141 "% at " "time-stamp,FIXME" "\n"
143 (tex-string-def "lilypond" 'classic "1")
146 (if (ly:get-option 'safe)
151 "lilypondpaper" 'linewidth
152 (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
153 "\\def\\lilyponddocumentclassoptions{"
154 (sanitize-tex-string texpaper)
155 (if landscape? ",landscape" "")
158 "lilypondpaper" 'interscoreline
160 (* scale (ly:output-def-lookup paper 'interscoreline)))))))
164 "\\def\\scaletounit{ "
165 (number->string (lily-unit->bigpoint-factor))
167 "\\ifx\\lilypondstart\\undefined\n"
168 " \\input lilyponddefs\n"
171 "\\lilypondspecial\n"
172 "\\lilypondpostscript\n"))
174 (define (dump-page putter page last? with-extents?)
175 (ly:outputter-dump-string
177 (format "\\lybox{~a}{~a}{%\n"
179 (interval-start (ly:stencil-extent page X))
182 (- (interval-start (ly:stencil-extent page Y)))
184 (ly:outputter-dump-stencil putter page)
185 (ly:outputter-dump-string
189 "}%\n\\vfill\n\\lilypondpagebreak\n")))
191 (define-public (output-framework basename book scopes fields)
192 (let* ((filename (format "~a.tex" basename))
193 (outputter (ly:make-paper-outputter filename "tex"))
194 (paper (ly:paper-book-paper book))
195 (pages (ly:paper-book-pages book))
196 (last-page (car (last-pair pages)))
198 (eq? #t (ly:output-def-lookup paper 'dump-extents))))
201 (ly:outputter-dump-string outputter x))
203 (header paper (length pages) #f)
206 (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
209 (dump-page outputter page (eq? last-page page) with-extents))
211 (ly:outputter-dump-string outputter "\\lilypondend\n")
212 (ly:outputter-close outputter)
213 (postprocess-output book framework-tex-module filename
216 (define (dump-line putter line last?)
217 (ly:outputter-dump-string
219 (format "\\lybox{~a}{~a}{%\n"
221 (max 0 (interval-end (ly:paper-system-extent line X))))
223 (interval-length (ly:paper-system-extent line Y)))))
225 (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
226 (ly:outputter-dump-string
230 "}\\interscoreline\n")))
232 (define-public (output-classic-framework
233 basename book scopes fields)
234 (let* ((filename (format "~a.tex" basename))
235 (outputter (ly:make-paper-outputter filename "tex"))
236 (paper (ly:paper-book-paper book))
237 (lines (ly:paper-book-systems book))
238 (last-line (car (last-pair lines))))
241 (ly:outputter-dump-string outputter x))
244 (header paper (length lines) #f)
245 "\\def\\lilypondclassic{1}%\n"
246 (output-scopes scopes fields basename)
251 (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
252 (ly:outputter-dump-string outputter "\\lilypondend\n")
253 (ly:outputter-close outputter)
254 (postprocess-output book framework-tex-module filename
258 (define-public (output-preview-framework
259 basename book scopes fields)
260 (let* ((filename (format "~a.tex" basename))
261 (outputter (ly:make-paper-outputter filename
263 (paper (ly:paper-book-paper book))
264 (lines (ly:paper-book-systems book))
265 (first-notes-index (list-index
266 (lambda (s) (not (ly:paper-system-title? s)))
271 (ly:outputter-dump-string outputter x))
275 (header paper (length lines) #f)
276 "\\def\\lilypondclassic{1}%\n"
277 (output-scopes scopes fields basename)
283 (dump-line outputter lst (not (ly:paper-system-title? lst))))
284 (take lines (1+ first-notes-index)))
285 (ly:outputter-dump-string outputter "\\lilypondend\n")
286 (ly:outputter-close outputter)
287 (postprocess-output book framework-tex-module filename
290 (define-public (convert-to-pdf book name)
291 (let* ((defs (ly:paper-book-paper book))
292 (papersizename (ly:output-def-lookup defs 'papersizename)))
293 (postscript->pdf (if (string? papersizename) papersizename "a4")
294 (string-append (basename name ".tex") ".ps"))))
296 (define-public (convert-to-png book name)
297 (let* ((defs (ly:paper-book-paper book))
298 (resolution (ly:output-def-lookup defs 'pngresolution))
299 (papersizename (ly:output-def-lookup defs 'papersizename)))
301 (if (number? resolution) resolution (ly:get-option 'resolution))
302 (if (string? papersizename) papersizename "a4")
303 (string-append (basename name ".tex") ".ps"))))
305 (define-public (convert-to-ps book name)
306 (let* ((paper (ly:paper-book-paper book))
307 (preview? (string-contains name ".preview"))
308 (papersizename (ly:output-def-lookup paper 'papersizename))
309 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
310 (base (basename name ".tex"))
311 (ps-name (format "~a.ps" base ".ps"))
312 (cmd (string-append "dvips"
317 ;; careful: papersizename is user-set.
318 (sanitize-command-option papersizename)
320 (if landscape? " -tlandscape" "")
321 (if (ly:kpathsea-find-file "lm.map")
323 (if (ly:kpathsea-find-file "ecrm10.pfa")
324 " -u+ec-mftrace.map" "")
325 " -u+lilypond.map -Ppdf" ""
328 (if (access? ps-name W_OK)
329 (delete-file ps-name))
330 (if (not (ly:get-option 'verbose))
332 (ly:message (_ "Converting to `~a'...") (string-append base ".ps"))
336 (define-public (convert-to-dvi book name)
337 (let* ((curr-extra-mem
339 (regexp-substitute/global
341 (ly:kpathsea-expand-variable "$extra_mem_top")
343 (base (basename name ".tex"))
345 #f "latex \\\\nonstopmode \\\\input '~a'" name)))
347 ;; FIXME: latex 'foo bar' works, but \input 'foe bar' does not?
348 (if (string-index name (char-set #\space #\ht #\newline #\cr))
349 (ly:error (_"TeX file name must not contain whitespace: `~a'") name))
351 (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
352 (let ((dvi-name (string-append base ".dvi")))
353 (if (access? dvi-name W_OK)
354 (delete-file dvi-name)))
355 (if (not (ly:get-option 'verbose))
357 (ly:message (_ "Converting to `~a'...") (string-append base ".dvi"))
360 ;; FIXME: set in environment?
361 (if (ly:get-option 'safe)
362 (set! cmd (string-append "openout_any=p " cmd)))
366 (define-public (convert-to-tex book name)