1 ;;; tex.scm -- implement Scheme output routines for TeX
3 ;;; source file of the GNU LilyPond music typesetter
5 ;;; (c) 1998--2000 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
9 (define (tex-scm action-name)
14 (define (select-font name-mag-pair)
17 (c (assoc name-mag-pair font-name-alist))
23 (display (object-type (car name-mag-pair)))
24 (display (object-type (caaar font-name-alist)))
26 (ly-warn (string-append
27 "Programming error: No such font known "
28 (car name-mag-pair) " "
29 (number->string (cdr name-mag-pair))
31 "") ; issue no command
32 (string-append "\\" (cddr c)))
37 (define (beam width slope thick)
38 (embedded-ps ((ps-scm 'beam) width slope thick)))
40 (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
41 (embedded-ps ((ps-scm 'bracket) arch_angle arch_width arch_height width height arch_thick thick)))
43 (define (dashed-slur thick dash l)
44 (embedded-ps ((ps-scm 'dashed-slur) thick dash l)))
46 (define (crescendo thick w h cont)
47 (embedded-ps ((ps-scm 'crescendo) thick w h cont)))
50 (string-append "\\char" (inexact->string i 10) " "))
52 (define (dashed-line thick on off dx dy)
53 (embedded-ps ((ps-scm 'dashed-line) thick on off dx dy)))
55 (define (decrescendo thick w h cont)
56 (embedded-ps ((ps-scm 'decrescendo) thick w h cont)))
58 (define (font-load-command name-mag command)
60 "\\font\\" command "="
63 (number->string (inexact->exact (* 1000 (cdr name-mag))))
66 (define (embedded-ps s)
67 (string-append "\\embeddedps{" s "}"))
70 (string-append "% " s))
74 ; uncomment for some stats about lily memory
75 ; (display (gc-stats))
76 (string-append "\n\\EndLilyPondOutput"
80 (define (experimental-on)
83 (define (font-switch i)
87 (define (font-def i s)
89 "\\font" (font-switch i) "=" s "\n"))
95 ;; URG: ly-gulp-file: now we can't use scm output without Lily
97 ;; fixed in 1.3.4 for powerpc -- broken on Windows
98 (regexp-substitute/global #f "\n"
99 (ly-gulp-file "lily.ps") 'pre " %\n" 'post)
100 (ly-gulp-file "lily.ps"))
102 "\\input lilyponddefs\\newdimen\\outputscale \\outputscale=\\lilypondpaperoutputscale pt\\turnOnPostScript"))
104 (define (header creator generate)
106 "%created by: " creator generate "\n"))
108 (define (invoke-char s i)
110 "\n\\" s "{" (inexact->string i 10) "}" ))
112 (define (invoke-dim1 s d)
114 "\n\\" s "{" (number->dim d) "}"))
119 ;; need to do something to make this really safe.
121 (define (output-tex-string s)
122 (if security-paranoia
124 (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
125 (begin (display "warning: not paranoid") (newline) s))
128 (define (lily-def key val)
132 ;; fixed in 1.3.4 for powerpc -- broken on Windows
133 (regexp-substitute/global #f "_"
134 (output-tex-string key) 'pre "X" 'post)
135 (output-tex-string key))
136 "{" (output-tex-string val) "}\n"))
138 (define (number->dim x)
140 ;;ugh ly-* in backend needs compatibility func for standalone output
141 (ly-number->string x) " \\outputscale "))
143 (define (placebox x y s)
146 (number->dim y) "}{" (number->dim x) "}{" s "}\n"))
148 (define (bezier-sandwich l thick)
149 (embedded-ps ((ps-scm 'bezier-sandwich) l thick)))
151 (define (start-line ht)
152 (string-append"\\vbox to " (number->dim ht) "{\\hbox{%\n"))
155 "}\\vss}\\interscoreline\n")
156 (define (stop-last-line)
158 (define (filledbox breapth width depth height)
160 "\\kern" (number->dim (- breapth))
161 "\\vrule width " (number->dim (+ breapth width))
162 "depth " (number->dim depth)
163 "height " (number->dim height) " "))
166 (string-append "\\hbox{" (output-tex-string s) "}"))
168 (define (tuplet ht gapx dx dy thick dir)
169 (embedded-ps ((ps-scm 'tuplet) ht gapx dx dy thick dir)))
171 (define (volta h w thick vert_start vert_end)
172 (embedded-ps ((ps-scm 'volta) h w thick vert_start vert_end)))
174 (define (define-origin file line col)
175 ; use this for column positions
177 (string-append "\\special{src:" (number->string line) ":"
178 (number->string col) " " file "}"
179 ;; arg, the clueless take over the mailing list...
180 ; "\\special{-****-These-warnings-are-harmless-***}"
181 ; "\\special{-****-PLEASE-read-http://appel.lilypond.org/wiki/index.php3?PostProcessing-****}"
186 ;(string-append "\\special{src:" (number->string line) " " file "}")
189 ; no-origin not yet supported by Xdvi
190 (define (no-origin) "")
193 ;; The procedures listed below form the public interface of TeX-scm.
194 ;; (should merge the 2 lists)
195 (cond ((eq? action-name 'all-definitions)
197 (define font-load-command ,font-load-command)
199 (define bezier-sandwich ,bezier-sandwich)
200 (define bracket ,bracket)
202 (define crescendo ,crescendo)
203 (define dashed-line ,dashed-line)
204 (define dashed-slur ,dashed-slur)
205 (define decrescendo ,decrescendo)
206 (define end-output ,end-output)
207 (define experimental-on ,experimental-on)
208 (define filledbox ,filledbox)
209 (define font-def ,font-def)
210 (define font-switch ,font-switch)
211 (define header-end ,header-end)
212 (define lily-def ,lily-def)
213 (define header ,header)
214 (define invoke-char ,invoke-char)
215 (define invoke-dim1 ,invoke-dim1)
216 (define placebox ,placebox)
217 (define select-font ,select-font)
218 (define start-line ,start-line)
219 (define stop-line ,stop-line)
220 (define stop-last-line ,stop-last-line)
222 (define tuplet ,tuplet)
223 (define volta ,volta)
224 (define define-origin ,define-origin)
225 (define no-origin ,no-origin)
228 ((eq? action-name 'beam) beam)
229 ((eq? action-name 'tuplet) tuplet)
230 ((eq? action-name 'bracket) bracket)
231 ((eq? action-name 'crescendo) crescendo)
232 ((eq? action-name 'dashed-line) dashed-line)
233 ((eq? action-name 'dashed-slur) dashed-slur)
234 ((eq? action-name 'decrescendo) decrescendo)
235 ((eq? action-name 'end-output) end-output)
236 ((eq? action-name 'experimental-on) experimental-on)
237 ((eq? action-name 'font-def) font-def)
238 ((eq? action-name 'font-switch) font-switch)
239 ((eq? action-name 'header-end) header-end)
240 ((eq? action-name 'lily-def) lily-def)
241 ((eq? action-name 'header) header)
242 ((eq? action-name 'invoke-char) invoke-char)
243 ((eq? action-name 'invoke-dim1) invoke-dim1)
244 ((eq? action-name 'placebox) placebox)
245 ((eq? action-name 'bezier-sandwich) bezier-sandwich)
246 ((eq? action-name 'start-line) start-line)
247 ((eq? action-name 'stem) stem)
248 ((eq? action-name 'stop-line) stop-line)
249 ((eq? action-name 'stop-last-line) stop-last-line)
250 ((eq? action-name 'volta) volta)
251 (else (error "unknown tag -- PS-TEX " action-name))
255 (define (scm-tex-output)
256 (ly-eval (tex-scm 'all-definitions)))