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