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
12 (use-modules (ice-9 regex)
20 ;; what is bla supposed to do? It breaks the default output terribly:
22 ;; \def\lilypondpaperbla$\backslash${$\backslash$}{bla$\backslash${$\backslash$}}%
23 ;; \lyitem{089.5557}{-15.3109}{\hbox{\magfontUGQLomTVo{}bla$\backslash${$\backslash$}}}%
25 (define-public (sanitize-tex-string s)
26 (if (ly:get-option 'safe)
27 (regexp-substitute/global #f "\\\\"
28 (regexp-substitute/global #f "([{}])" "bla{}" 'pre "\\" 1 'post )
29 'pre "$\\backslash$" 'post)
33 (define (symbol->tex-key sym)
34 (regexp-substitute/global
35 #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post) )
37 (define (tex-number-def prefix key number)
39 "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
41 (define-public (tex-font-command font)
44 (string-encode-integer
45 (hashq (ly:font-filename font) 1000000))
47 (string-encode-integer
48 (inexact->exact (round (* 1000 (ly:font-magnification font)))))))
50 (define (font-load-command paper font)
51 (let* ((coding-alist (ly:font-encoding-alist font))
52 (font-encoding (assoc-get 'output-name coding-alist)))
55 "\\font\\lilypond" (tex-font-command font) "="
56 (ly:font-filename font)
58 (ly:number->string (inexact->exact
60 (ly:font-magnification font)
61 (ly:paper-outputscale paper)))))
63 "\\def\\" (tex-font-command font) "{%\n"
64 ;; UGH. Should be handled via alist.
65 (if (equal? "Extended-TeX-Font-Encoding---Latin" font-encoding)
66 " \\lilypondfontencoding{T1}"
68 "\\lilypond" (tex-font-command font)
73 (define (define-fonts paper)
76 "\\def\\lilypondpaperunit{mm}\n"
77 (tex-number-def "lilypondpaper" 'outputscale
78 (number->string (exact->inexact
79 (ly:paper-outputscale paper))))
80 (tex-string-def "lilypondpaper" 'papersize
81 (eval 'papersize (ly:output-def-scope paper)))
83 (tex-string-def "lilypondpaper" 'inputencoding
84 (eval 'inputencoding (ly:output-def-scope paper)))
87 (map (lambda (x) (font-load-command paper x))
88 (ly:paper-fonts paper)))))
90 (define (header-to-file fn key val)
91 (set! key (symbol->string key))
92 (if (not (equal? "-" fn))
93 (set! fn (string-append fn "." key)))
95 (format (_ "Writing header field `~a' to `~a'...")
97 (if (equal? "-" fn) "<stdout>" fn))
101 (display val (open-file fn "w")))
102 (newline (current-error-port))
105 (define (output-scopes scopes fields basename)
106 (define (output-scope scope)
111 (let ((val (if (variable-bound? var) (variable-ref var) ""))
114 (if (and (memq sym fields) (string? val))
115 (header-to-file basename sym val))
118 (apply string-append (map output-scope scopes)))
120 (define (tex-string-def prefix key str)
121 (if (equal? "" (sans-surrounding-whitespace (sanitize-tex-string str)))
122 (string-append "\\let\\" prefix (symbol->tex-key key) "\\undefined%\n")
123 (string-append "\\def\\" prefix (symbol->tex-key key)
124 "{" (sanitize-tex-string str) "}%\n")))
126 (define (header paper page-count classic?)
127 (let ((scale (ly:output-def-lookup paper 'outputscale))
128 (texpaper (string-append
129 (ly:output-def-lookup paper 'papersizename)
131 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
134 "% Generated by LilyPond "
135 (lilypond-version) "\n"
136 "% at " "time-stamp,FIXME" "\n"
138 (tex-string-def "lilypond" 'classic "1")
141 (if (ly:get-option 'safe)
146 "lilypondpaper" 'linewidth
147 (ly:number->string (* scale (ly:output-def-lookup paper 'linewidth))))
148 "\\def\\lilyponddocumentclassoptions{"
150 (if landscape? ",landscape" "")
153 "lilypondpaper" 'interscoreline
155 (* scale (ly:output-def-lookup paper 'interscoreline)))))))
159 "\\def\\scaletounit{ "
160 (number->string (cond
161 ((equal? (ly:unit) "mm") (/ 72.0 25.4))
162 ((equal? (ly:unit) "pt") (/ 72.0 72.27))
163 (else (error "unknown unit" (ly:unit)))))
165 "\\ifx\\lilypondstart\\undefined\n"
166 " \\input lilyponddefs\n"
168 "\\outputscale = \\lilypondpaperoutputscale\\lilypondpaperunit\n"
170 "\\lilypondspecial\n"
171 "\\lilypondpostscript\n"))
173 (define (dump-page putter page last? with-extents?)
174 (ly:outputter-dump-string
176 (format "\\vbox to ~a\\outputscale{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n"
178 (- (interval-start (ly:stencil-extent page Y)))
181 (ly:outputter-dump-stencil putter page)
182 (ly:outputter-dump-string
185 "}\\vss\n}\n\\vfill\n"
186 "}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
188 (define-public (output-framework outputter book scopes fields basename )
189 (let* ((paper (ly:paper-book-paper book))
190 (pages (ly:paper-book-pages book))
191 (last-page (car (last-pair pages)))
193 (eq? #t (ly:output-def-lookup paper 'dump-extents)))
197 (ly:outputter-dump-string outputter x))
199 (header paper (length pages) #f)
202 (ly:outputter-dump-string outputter "\\lilypondnopagebreak")
204 (lambda (page) (dump-page outputter page (eq? last-page page) with-extents))
206 (ly:outputter-dump-string outputter "\\lilypondend\n")))
208 (define (dump-line putter line last?)
209 (ly:outputter-dump-string
211 (string-append "\\leavevmode\n\\lybox{0}{0}{0}{"
212 (ly:number->string (interval-length (ly:paper-system-extent line Y)))
215 (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
216 (ly:outputter-dump-string
220 "}\\interscoreline\n")))
222 (define-public (output-classic-framework
223 outputter book scopes fields basename)
224 (let* ((paper (ly:paper-book-paper book))
225 (lines (ly:paper-book-systems book))
226 (last-line (car (last-pair lines))))
229 (ly:outputter-dump-string outputter x))
232 (header paper (length lines) #f)
233 "\\def\\lilypondclassic{1}%\n"
234 (output-scopes scopes fields basename)
239 (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
240 (ly:outputter-dump-string outputter "\\lilypondend\n")))
243 (define-public (output-preview-framework
244 outputter book scopes fields basename )
245 (let* ((paper (ly:paper-book-paper book))
246 (lines (ly:paper-book-systems book)))
249 (ly:outputter-dump-string outputter x))
252 (header paper (length lines) #f)
253 "\\def\\lilypondclassic{1}%\n"
254 (output-scopes scopes fields basename)
258 (dump-line outputter (car lines) #t)
259 (ly:outputter-dump-string outputter "\\lilypondend\n")))
262 (define-public (convert-to-pdf book name)
263 (let* ((defs (ly:paper-book-paper book))
264 (size (ly:output-def-lookup defs 'papersize)))
266 (postscript->pdf (if (string? size) size "a4")
267 (string-append (basename name ".tex") ".ps"))))
269 (define-public (convert-to-png book name)
271 ((defs (ly:paper-book-paper book))
272 (resolution (ly:output-def-lookup defs 'pngresolution)))
275 (if (number? resolution) resolution 90)
276 (string-append (basename name ".tex") ".ps"))))
278 (define-public (convert-to-ps book name)
279 (let* ((paper (ly:paper-book-paper book))
280 (papersize (ly:output-def-lookup paper 'papersizename))
281 (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
282 (cmd (string-append "dvips -t " papersize
283 (if landscape? " -t landscape " " ")
284 " -u+ec-mftrace.map -u+lilypond.map -Ppdf "
285 (basename name ".tex"))))
287 (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
288 (newline (current-error-port))
291 (define-public (convert-to-dvi book name)
293 ((curr-extra-mem (string->number (regexp-substitute/global #f " *%.*\n?"
294 (ly:kpathsea-expand-variable "$extra_mem_top")
296 (cmd (string-append "latex \\\\nonstopmode \\\\input " name)))
298 (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
299 (newline (current-error-port))
300 (display (format #f (_ "Invoking ~S") cmd) (current-error-port))
301 (newline (current-error-port))
303 ;; fixme: set in environment?
304 (if (ly:get-option 'safe)
305 (set! cmd (string-append "openout_any=p " cmd)))
309 (define-public (convert-to-tex book name)