]> git.donarmstrong.com Git - lilypond.git/blob - scm/framework-tex.scm
*** empty log message ***
[lilypond.git] / scm / framework-tex.scm
1 ;;;; framework-tex.scm -- structure for TeX output
2 ;;;;
3 ;;;; source file of the GNU LilyPond music typesetter
4 ;;;;
5 ;;;; (c) 2004--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
6
7 (define-module (scm framework-tex)
8   #:export (output-framework-tex        
9             output-classic-framework-tex))
10
11 (use-modules (ice-9 regex)
12              (ice-9 string-fun)
13              (ice-9 format)
14              (scm page)
15              (scm paper-system)
16              (guile)
17              (srfi srfi-1)
18              (srfi srfi-13)
19              (srfi srfi-14)
20              (scm kpathsea)
21              (lily))
22
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)))
30
31   (uniq-list formats))
32
33 (define framework-tex-module (current-module))
34 (define-public (sanitize-tex-string s)
35   (if (ly:get-option 'safe)
36       (regexp-substitute/global
37        #f "\\\\"
38        (regexp-substitute/global #f "([{}])" s 'pre  "\\" 1 'post)
39        'pre "$\\backslash$" 'post)
40       s))
41
42 (define (symbol->tex-key sym)
43   (regexp-substitute/global
44    #f "_" (sanitize-tex-string (symbol->string sym)) 'pre "X" 'post))
45
46 (define (tex-number-def prefix key number)
47   (string-append
48    "\\def\\" prefix (symbol->tex-key key) "{" number "}%\n"))
49
50 (define-public (digits->letters str)
51   (regexp-substitute/global
52    #f "[-\\._]"
53    (regexp-substitute/global
54     #f "([0-9])" str
55     'pre
56     (lambda (match)
57       (make-string
58        1
59        (integer->char
60         (+ (char->integer #\A)
61            (- (char->integer #\0))
62            (char->integer (string-ref (match:substring match 1) 0)))
63         )))
64     'post)
65    'pre ""
66    'post))
67
68 (define-public (tex-font-command-raw name magnification)
69   (string-append
70    "magfont"
71    (digits->letters (format "~a" name))
72    "m"
73    (string-encode-integer
74     (inexact->exact (round (* 1000 magnification))))))
75
76 (define-public (tex-font-command font)
77   (tex-font-command-raw
78    (ly:font-file-name font) (ly:font-magnification font)))
79
80 (define (otf-font-load-command paper font)
81   (let* ((sub-fonts (ly:font-sub-fonts font)))
82     (string-append
83      (apply string-append
84             (map
85              (lambda (sub-name)
86                (format #f "\\font\\~a=~a scaled ~a%\n"
87                        (tex-font-command-raw
88                         sub-name (ly:font-magnification font))
89                        sub-name
90                        (ly:number->string
91                         (inexact->exact
92                          (round (* 1000
93                                    (ly:font-magnification font)
94                                    (ly:paper-output-scale paper)))))))
95              sub-fonts)))))
96
97 (define (simple-font-load-command paper font)
98    (format
99     "\\font\\~a=~a scaled ~a%\n"
100     (tex-font-command font)
101     (ly:font-file-name font)
102     (inexact->exact
103      (round (* 1000
104                (ly:font-magnification font)
105                (ly:paper-output-scale paper))))))
106
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)))
111
112 (define (define-fonts paper)
113   (string-append
114    ;; UGH. FIXME.
115    "\\def\\lilypondpaperunit{mm}%\n"
116    (tex-number-def "lilypondpaper" 'output-scale
117                    (number->string (exact->inexact
118                                     (ly:paper-output-scale paper))))
119    (tex-string-def "lilypondpaper" 'papersize
120                    (eval 'papersizename (ly:output-def-scope paper)))
121    ;; paper/layout?
122    (tex-string-def "lilypondpaper" 'input-encoding
123                    (eval 'input-encoding (ly:output-def-scope paper)))
124
125    (apply string-append
126           (map (lambda (x) (font-load-command paper x))
127                (ly:paper-fonts paper)))))
128
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")))
134
135 (define (header paper page-count classic?)
136   (let ((scale (ly:output-def-lookup paper 'output-scale))
137         (texpaper (string-append
138                    (ly:output-def-lookup paper 'papersizename)
139                    "paper"))
140         (landscape? (eq? #t (ly:output-def-lookup paper 'landscape))))
141     (string-append
142      "% Generated by LilyPond "
143      (lilypond-version) "\n"
144      "% at " "time-stamp,FIXME" "\n"
145      (if classic?
146          (tex-string-def "lilypond" 'classic "1")
147          "")
148
149      (if (ly:get-option 'safe)
150          "\\nofiles\n"
151          "")
152
153      (tex-string-def
154       "lilypondpaper" 'line-width
155       (ly:number->string (* scale (ly:output-def-lookup paper 'line-width))))
156      "\\def\\lilyponddocumentclassoptions{"
157      (sanitize-tex-string texpaper)
158      (if landscape? ",landscape" "")
159      "}%\n"
160      )))
161
162 (define (header-end)
163   (string-append
164    "\\def\\scaletounit{ "
165    (number->string lily-unit->bigpoint-factor)
166    " mul }%\n"
167    "\\ifx\\lilypondstart\\undefined\n"
168    "  \\input lilyponddefs\n"
169    "\\fi\n"
170    "\\lilypondstart\n"
171    "\\lilypondspecial\n"
172    "\\lilypondpostscript\n"))
173
174 (define (dump-page putter page last? with-extents?)
175   (ly:outputter-dump-string
176    putter
177    (format "\\lybox{~a}{~a}{%\n"
178            (if with-extents?
179                (interval-start (ly:stencil-extent page X))
180                0.0)
181            (if with-extents?
182                (- (interval-start (ly:stencil-extent page Y)))
183                0.0)))
184   (ly:outputter-dump-stencil putter page)
185   (ly:outputter-dump-string
186    putter
187    (if last?
188        "}%\n\\vfill\n"
189        "}%\n\\vfill\n\\lilypondpagebreak\n")))
190
191 (define-public (output-framework basename book scopes fields)
192   (let* ((filename (format "~a.tex" basename))
193          (outputter  (ly:make-paper-outputter (open-file filename "wb") "tex"))
194          (paper (ly:paper-book-paper book))
195          (page-stencils (map page-stencil (ly:paper-book-pages book)))
196          (last-page (car (last-pair pages)))
197          (with-extents
198           (eq? #t (ly:output-def-lookup paper 'dump-extents))))
199     (for-each
200      (lambda (x)
201        (ly:outputter-dump-string outputter x))
202      (list
203       (header paper (length page-stencils) #f)
204       (define-fonts paper)
205       (header-end)))
206     (ly:outputter-dump-string outputter "\\lilypondnopagebreak\n")
207     (for-each
208      (lambda (page)
209        (dump-page outputter page (eq? last-page page) with-extents))
210      page-stencils)
211     (ly:outputter-dump-string outputter "\\lilypondend\n")
212     (ly:outputter-close outputter)
213     (postprocess-output book framework-tex-module filename
214                         (output-formats))))
215
216 (define (dump-line putter line last?)
217   (ly:outputter-dump-string
218    putter
219    (format "\\lybox{~a}{~a}{%\n"
220            (ly:number->string
221             (max 0 (interval-end (paper-system-extent line X))))
222            (ly:number->string
223             (interval-length (paper-system-extent line Y)))))
224
225   (ly:outputter-dump-stencil putter (paper-system-stencil line))
226   (ly:outputter-dump-string
227    putter
228    (if last?
229        "}%\n"
230        "}\\interscoreline\n")))
231
232 (define-public (output-classic-framework
233                 basename book scopes fields)
234   (let* ((filename (format "~a.tex" basename))
235          (outputter  (ly:make-paper-outputter
236                       (open-file filename "w") "tex"))
237          (paper (ly:paper-book-paper book))
238          (lines (ly:paper-book-systems book))
239          (last-line (car (last-pair lines))))
240     (for-each
241      (lambda (x)
242        (ly:outputter-dump-string outputter x))
243      (list
244       ;;FIXME
245       (header paper (length lines) #f)
246       "\\def\\lilypondclassic{1}%\n"
247       (output-scopes scopes fields basename)
248       (define-fonts paper)
249       (header-end)))
250
251     (for-each
252      (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
253     (ly:outputter-dump-string outputter "\\lilypondend\n")
254     (ly:outputter-close outputter)
255     (postprocess-output book framework-tex-module filename
256                         (output-formats))
257     ))
258
259 (define-public (output-preview-framework
260                 basename book scopes fields)
261   (let* ((filename (format "~a.tex" basename))
262          (outputter  (ly:make-paper-outputter (open-file filename "wb")
263                                               "tex"))
264          (paper (ly:paper-book-paper book))
265          (lines (ly:paper-book-systems book))
266          (first-notes-index (list-index
267                              (lambda (s) (not (ly:paper-system-title? s)))
268                              lines)))
269
270     (for-each
271      (lambda (x)
272        (ly:outputter-dump-string outputter x))
273      (list
274       
275       ;;FIXME
276       (header paper (length lines) #f)
277       "\\def\\lilypondclassic{1}%\n"
278       (output-scopes scopes fields basename)
279       (define-fonts paper)
280       (header-end)))
281
282     (for-each
283      (lambda (lst)
284        (dump-line outputter lst (not (ly:paper-system-title? lst))))
285      (take lines (1+ first-notes-index)))
286     (ly:outputter-dump-string outputter "\\lilypondend\n")
287     (ly:outputter-close outputter)
288     (postprocess-output book framework-tex-module filename
289                         (output-formats))))
290
291 (define-public (convert-to-pdf book name)
292   (let* ((defs (ly:paper-book-paper book))
293          (paper-width (ly:output-def-lookup defs 'paper-width))
294          (paper-height (ly:output-def-lookup defs 'paper-height))
295          (output-scale (ly:output-def-lookup defs 'output-scale)))
296     (postscript->pdf (* paper-width output-scale (/ (ly:bp 1)))
297                      (* paper-height output-scale (/ (ly:bp 1)))
298                      (string-append (basename name ".tex") ".ps"))))
299
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          (paper-width (ly:output-def-lookup defs 'paper-width))
304          (paper-height (ly:output-def-lookup defs 'paper-height))
305          (output-scale (ly:output-def-lookup defs 'output-scale)))
306     (postscript->png
307      (if (number? resolution)
308          resolution
309          (ly:get-option 'resolution))
310
311      (* paper-width output-scale (/ (ly:bp 1)))
312      (* paper-height output-scale (/ (ly:bp 1)))
313
314      (string-append (basename name ".tex") ".ps"))))
315
316 (define-public (convert-to-ps book name)
317   (let* ((paper (ly:paper-book-paper book))
318          (preview? (string-contains name ".preview"))
319          (papersizename (ly:output-def-lookup paper 'papersizename))
320          (landscape? (eq? #t (ly:output-def-lookup paper 'landscape)))
321          (base (basename name ".tex"))
322          (ps-name (format "~a.ps"  base ".ps"))
323          (cmd (string-append "dvips"
324                              (if preview?
325                                  " -E"
326                                  (string-append
327                                   " -t"
328                                   ;; careful: papersizename is user-set.
329                                   (sanitize-command-option papersizename)
330                                   ""))
331                              (if landscape? " -tlandscape" "")
332                              (if (ly:kpathsea-find-file "lm.map")
333                                  " -u+lm.map" "")
334                              (if (ly:kpathsea-find-file "ecrm10.pfa")
335                                  " -u+ec-mftrace.map" "")
336                              " -u+lilypond.map -Ppdf" ""
337                              " -o" ps-name
338                              " " base)))
339     (if (access? ps-name W_OK)
340         (delete-file ps-name))
341     (if (not (ly:get-option 'verbose))
342         (begin
343           (ly:message (_ "Converting to `~a'...") (string-append base ".ps"))
344           (ly:progress "\n")))
345     (ly:system cmd)))
346
347 (define-public (convert-to-dvi book name)
348   (let* ((curr-extra-mem
349           (string->number
350            (regexp-substitute/global
351             #f " *%.*\n?"
352             (ly:kpathsea-expand-variable "extra_mem_top")
353             'pre "" 'post)))
354          (base (basename name ".tex"))
355          (cmd (format
356                #f "latex \\\\nonstopmode \\\\input '~a'" name)))
357
358     ;; FIXME: latex 'foo bar' works, but \input 'foe bar' does not?
359     (if (string-index name (char-set #\space #\ht #\newline #\cr))
360         (ly:error (_"TeX file name must not contain whitespace: `~a'") name))
361
362     (setenv "extra_mem_top" (number->string (max curr-extra-mem 1024000)))
363     (let ((dvi-name (string-append base ".dvi")))
364       (if (access? dvi-name W_OK)
365           (delete-file dvi-name)))
366     (if (not (ly:get-option 'verbose))
367         (begin
368           (ly:message (_ "Converting to `~a'...") (string-append base ".dvi"))
369           (ly:progress "\n")))
370
371     ;; FIXME: set in environment?
372     (if (ly:get-option 'safe)
373         (set! cmd (string-append "openout_any=p " cmd)))
374
375     (ly:system cmd)))
376
377 (define-public (convert-to-tex book name)
378   #t)
379