1 ;;;; pdftex.scm -- implement Scheme output routines for PDFTeX
3 ;;;; source file of the GNU LilyPond music typesetter
4 ;;;; modified from the existing tex.scm
6 ;;;; (c) 1998--2004 Jan Nieuwenhuizen <janneke@gnu.org>
7 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
8 ;;;; Stephen Peters <portnoy@portnoy.org>
11 ;; TODO: port this to the new module framework.
13 (define-module (scm output-pdftex))
15 (use-modules (scm output-pdf)
21 (define font-name-alist '())
23 (define this-module (current-module))
27 (define (select-font name-mag-pair)
28 (let* ((c (assoc name-mag-pair font-name-alist)))
33 (display (object-type (car name-mag-pair)))
34 (display (object-type (caaar font-name-alist)))
36 (ly:warn "Programming error: No such font known ~S ~S"
38 (ly:number->string (cdr name-mag-pair)))
39 "") ; issue no command
40 (string-append "\\" (cddr c)))))
42 (define (beam width slope thick blot)
43 (embedded-pdf (list 'beam width slope thick blot)))
45 (define (bracket arch_angle arch_width arch_height height arch_thick thick)
46 (embedded-pdf (list 'bracket arch_angle arch_width arch_height height arch_thick thick)))
48 (define (dashed-slur thick dash lst)
49 (embedded-pdf (list 'dashed-slur thick dash lst)))
52 (string-append "\\char" (ly:inexact->string i 10) " "))
54 (define (dashed-line thick on off dx dy)
55 (embedded-pdf (list 'dashed-line thick on off dx dy)))
57 (define (font-load-command name-mag command)
59 "\\font\\" command "="
62 (ly:number->string (inexact->exact (* 1000 (cdr name-mag))))
65 (define (ez-ball c lst b)
66 (embedded-pdf (list 'ez-ball c lst b)))
68 (define (header-to-file fn key val)
69 (set! key (symbol->string key))
70 (if (not (equal? "-" fn))
71 (set! fn (string-append fn "." key)))
73 (format "writing header field `~a' to `~a'..."
75 (if (equal? "-" fn) "<stdout>" fn))
79 (display val (open-file fn "w")))
80 (display "\n" (current-error-port))
83 (define (embedded-pdf expr)
84 (let ((os (open-output-string)))
85 (pdf-output-expression expr os)
86 (string-append "\\embeddedpdf{" (get-output-string os) "}")))
88 (define (experimental-on)
91 (define (repeat-slash w a t)
92 (embedded-pdf (list 'repeat-slash w a t)))
94 (define (tex-encoded-fontswitch name-mag)
95 (let* ((iname-mag (car name-mag))
96 (ename-mag (cdr name-mag)))
99 (string-append "magfont"
100 (string-encode-integer
101 (hashq (car ename-mag) 1000000))
103 (string-encode-integer
104 (inexact->exact (* 1000 (cdr ename-mag)))))))))
105 (define (define-fonts internal-external-name-mag-pairs)
106 (set! font-name-alist (map tex-encoded-fontswitch
107 internal-external-name-mag-pairs))
110 (font-load-command (car x) (cdr x)))
111 (map cdr font-name-alist))))
113 (define (font-switch i)
117 (define (font-def i s)
119 "\\font" (font-switch i) "=" s "\n"))
123 "\\def\\lilyoutputscalefactor{"
124 (number->string (cond
125 ((equal? (ly:unit) "mm") (/ 72.0 25.4))
126 ((equal? (ly:unit) "pt") (/ 72.0 72.27))
127 (else (error "unknown unit" (ly:unit)))))
129 "\\ifx\\lilypondstart\\undefined\n"
130 " \\input lilyponddefs\n"
132 "\\outputscale=\\lilypondpaperoutputscale \\lilypondpaperunit\n"
133 "\\lilypondpostscript\n"
134 "\\pdfcompresslevel=0"))
136 ;; Note: this string must match the string in lilypond.py!!!
137 (define (header creator generate)
139 "% Generated automatically by: " creator generate "\n"))
141 (define (invoke-char s i)
143 "\n\\" s "{" (ly:inexact->string i 10) "}" ))
145 ;; FIXME: explain ploblem: need to do something to make this really safe.
146 (define (output-tex-string s)
147 (if (ly:get-option 'safe)
148 (regexp-substitute/global
150 (regexp-substitute/global #f "\\([{}]\\)" s 'pre "\\1" 'post)
151 'pre "$\\backslash$" 'post)
154 (define (lily-def key val)
156 (regexp-substitute/global
157 #f "_" (output-tex-string key) 'pre "X" 'post))
158 (tex-val (output-tex-string val)))
159 (if (equal? (sans-surrounding-whitespace tex-val) "")
160 (string-append "\\let\\" tex-key "\\undefined\n")
161 (string-append "\\def\\" tex-key "{" tex-val "}%\n"))))
163 (define (number->dim x)
165 ;;ugh ly:* in backend needs compatibility func for standalone output
166 (ly:number->string x) " \\outputscale "))
168 (define (placebox x y s)
169 (string-append "\\lyitem{"
170 (ly:number->string y) "}{"
171 (ly:number->string x) "}{"
174 (define (bezier-sandwich lst thick)
175 (embedded-pdf (list 'bezier-sandwich `(quote ,lst) thick)))
177 (define (start-system wd ht)
178 (string-append "\\leavevmode\n"
179 "\\scoreshift = " (number->dim (* ht 0.5)) "\n"
180 "\\lilypondifundefined{lilypondscoreshift}%\n"
182 " {\\advance\\scoreshift by -\\lilypondscoreshift}%\n"
184 (ly:number->string wd) "}{"
185 (ly:number->string ht) "}{%\n"))
187 (define (stop-system)
188 "}%\n%\n\\interscoreline\n%\n")
189 (define (stop-last-system)
192 (define (filledbox breapth width depth height)
193 (string-append "\\lyvrule{"
194 (ly:number->string (- breapth)) "}{"
195 (ly:number->string (+ breapth width)) "}{"
196 (ly:number->string depth) "}{"
197 (ly:number->string height) "}"))
199 (define (round-filled-box x y width height blotdiam)
200 (embedded-pdf (list 'round-filled-box x y width height blotdiam)))
203 (string-append "\\hbox{" (output-tex-string s) "}"))
205 (define (draw-line thick fx fy tx ty)
206 (embedded-pdf (list 'draw-line thick fx fy tx ty)))
208 (define (define-origin file line col)
209 (if (procedure? point-and-click)
210 (string-append "\\special{src:\\string:"
211 (point-and-click line col file)
215 ;; no-origin not supported in PDFTeX
216 (define (no-origin) "")
218 (define-public (pdftex-output-expression expr port)
219 (display (eval expr this-module) port) )