1 ; lily.scm -- implement Scheme output routines for TeX and PostScript
3 ; source file of the GNU LilyPond music typesetter
5 ; (c) 1998 Jan Nieuwenhuizen <janneke@gnu.org>
9 ; - ready ps code (draw_bracket) vs tex/ps macros/calls (pianobrace),
10 ; all preparations from ps,tex to scm
12 ;;; graphical lisp element
13 (define (add-column p) (display "adding column (in guile): ") (display p) (newline))
19 (map (lambda (n) (string-append (number->string n) " ")) l)))
21 (define (number->octal-string x)
22 (let* ((n (inexact->exact x))
24 (n8 (quotient (- n (* n64 64)) 8)))
28 (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
30 (define (inexact->string x radix)
31 (let ((n (inexact->exact x)))
32 (number->string n radix)))
37 (number->string x) "pt "))
42 (string-append (number->string (car c)) " ")
43 (string-append (number->string (cadr c)) " ")))
47 (string-append "\\embeddedps{" s "}"))
52 "(\\" (inexact->string i 8) ") " s " " ))
57 "\n\\" s "{" (inexact->string i 10) "}" ))
62 (number->string d) " " s ))
67 "\n\\" s "{" (number->dim-tex d) "}"))
71 (eval-string (string-append s "-" o)))
73 ;;; output definitions
76 (beam o width slope thick)
77 ((invoke-output o "beam") width slope thick))
80 (beam-ps width slope thick)
82 (numbers->string (list width slope thick)) " draw_beam " ))
85 (beam-tex width slope thick)
86 (embedded-ps-tex (beam-ps width slope thick)))
90 ((invoke-output o "bracket") h))
94 (invoke-dim1-ps "draw_bracket" h))
98 (embedded-ps-tex (bracket-ps h)))
102 ((invoke-output o "invoke-char") "show" n))
105 (dashed-slur o thick dash l)
106 ((invoke-output o "dashed-slur") thick dash l))
109 (dashed-slur-ps thick dash l)
111 (apply string-append (map control->string l))
112 (number->string thick)
114 (if (> 1 dash) (number->string (- (* thick dash) thick)) "0") " "
115 (number->string (* 2 thick))
116 " ] 0 draw_dashed_slur"))
119 (dashed-slur-tex thick dash l)
120 (embedded-ps-tex (dashed-slur-ps thick dash l)))
124 ((invoke-output o "invoke-dim1") "doublebar" h))
128 ((invoke-output o "empty")))
139 (emptybar o h) (empty o))
143 ((invoke-output o "end-output")))
151 "\n\\EndLilyPondOutput")
155 ((invoke-output o "experimental-on")))
158 (experimental-on-ps) "")
161 (experimental-on-tex) "\\turnOnExperimentalFeatures")
165 ((invoke-output o "invoke-dim1") "fatdoublebar" h))
169 ((invoke-output o "invoke-dim1") "finishbar" h))
175 (make-string 1 (integer->char (+ (char->integer #\A) i)))
180 ((invoke-output o "font-def") i s))
187 (substring s 0 (- (string-length s) 3))
188 " findfont 12 scalefont setfont} bind def\n"))
193 "\\font" (font-switch-tex i) "=" s "\n"))
197 ((invoke-output o "font-switch") i))
201 (string-append (font i) " "))
209 (generalmeter o num den)
210 ((invoke-output o "generalmeter") num den))
213 (generalmeter-ps num den)
214 (string-append (number->string (inexact->exact num)) " " (number->string (inexact->exact den)) " generalmeter "))
217 (generalmeter-tex num den)
219 "\\generalmeter{" (number->string (inexact->exact num)) "}{" (number->string (inexact->exact den)) "}"))
222 (header o creator generate)
223 ((invoke-output o "header") creator generate))
226 (header-ps creator generate)
229 "%%Creator: " creator generate "\n"))
232 (header-tex creator generate)
234 "%created by: " creator generate "\n"))
238 ((invoke-output o "header-end")))
244 (header-end-tex) "\\turnOnPostScript")
248 ((invoke-output o "lily-def") key val))
251 (lily-def-ps key val)
253 "/" key " {" val "} bind def\n"))
256 (lily-def-tex key val)
258 "\\def\\" key "{" val "}\n"))
262 ((invoke-output o "invoke-dim1") "maatstreep" h))
266 ((invoke-output o "invoke-char") "pianobrace" i))
270 ((invoke-output o "placebox") x y (b o)))
275 (number->string x) " " (number->string y) " {" s "} placebox "))
281 (number->dim-tex y) "}{" (number->dim-tex x) "}{" s "}"))
285 ((invoke-output o "invoke-dim1") "repeatbar" h))
288 (repeatbarstartrepeat o h)
289 ((invoke-output o "invoke-dim1") "repeatbarstartrepeat" h))
293 ((invoke-output o "rulesym") x y))
298 (number->string x) " "
299 (number->string y) " "
305 "\\rulesym{" (number->dim-tex x) "}{" (number->dim-tex y) "}"))
309 ((invoke-output o "text") "bold" s))
312 (setdynamic o s) (empty o))
316 ((invoke-output o "text") "finger" s))
320 ((invoke-output o "text") "huge" s))
324 ((invoke-output o "text") "italic" s))
328 ((invoke-output o "text") "large" s))
332 ((invoke-output o "text") "Large" s))
336 ((invoke-output o "text") "number" s))
340 ((invoke-output o "text") "text" s))
344 ((invoke-output o "text") "typewriter" s))
348 ((invoke-output o "slur") l))
353 (apply string-append (map control->string l))
358 (embedded-ps-tex (slur-ps l)))
361 (stem o kern width height depth)
362 ((invoke-output o "stem") kern width height depth))
365 (stem-ps kern width height depth)
366 (string-append (numbers->string (list kern width height depth))
370 (stem-tex kern width height depth)
372 "\\kern" (number->dim-tex kern)
373 "\\vrule width " (number->dim-tex width)
374 "depth " (number->dim-tex depth)
375 "height " (number->dim-tex height) " "))
379 ((invoke-output o "start-line")))
395 ((invoke-output o "invoke-dim1") "startrepeat" h))
399 ((invoke-output o "stop-line")))
411 ((invoke-output o "invoke-dim1") "stoprepeat" h))
415 (string-append "(" s ") set" f " "))
419 (string-append "\\set" f "{" s "}"))
423 "/fontA { /feta20 findfont 12 scalefont setfont} bind def fontA\n")
427 "\\font\\fontA=feta20.afm\\fontA\n")
430 (urg-font-switch-ps i)
431 "\n/feta20 findfont 12 scalefont setfont \n")