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") "finishbar" h))
171 (make-string 1 (integer->char (+ (char->integer #\A) i)))
176 ((invoke-output o "font-def") i s))
183 (substring s 0 (- (string-length s) 3))
184 " findfont 12 scalefont setfont} bind def\n"))
189 "\\font" (font-switch-tex i) "=" s "\n"))
193 ((invoke-output o "font-switch") i))
197 (string-append (font i) " "))
205 (generalmeter o num den)
206 ((invoke-output o "generalmeter") num den))
209 (generalmeter-ps num den)
210 (string-append (number->string (inexact->exact num)) " " (number->string (inexact->exact den)) " generalmeter "))
213 (generalmeter-tex num den)
215 "\\generalmeter{" (number->string (inexact->exact num)) "}{" (number->string (inexact->exact den)) "}"))
218 (header o creator generate)
219 ((invoke-output o "header") creator generate))
222 (header-ps creator generate)
225 "%%Creator: " creator generate "\n"))
228 (header-tex creator generate)
230 "%created by: " creator generate "\n"))
234 ((invoke-output o "header-end")))
240 (header-end-tex) "\\turnOnPostScript")
244 ((invoke-output o "lily-def") key val))
247 (lily-def-ps key val)
249 "/" key " {" val "} bind def\n"))
252 (lily-def-tex key val)
254 "\\def\\" key "{" val "}\n"))
258 ((invoke-output o "invoke-dim1") "maatstreep" h))
262 ((invoke-output o "invoke-char") "pianobrace" i))
266 ((invoke-output o "placebox") x y (b o)))
271 (number->string x) " " (number->string y) " {" s "} placebox "))
277 (number->dim-tex y) "}{" (number->dim-tex x) "}{" s "}"))
281 ((invoke-output o "invoke-dim1") "repeatbar" h))
284 (repeatbarstartrepeat o h)
285 ((invoke-output o "invoke-dim1") "repeatbarstartrepeat" h))
289 ((invoke-output o "rulesym") x y))
294 (number->string x) " "
295 (number->string y) " "
301 "\\rulesym{" (number->dim-tex x) "}{" (number->dim-tex y) "}"))
305 ((invoke-output o "text") "bold" s))
308 (setdynamic o s) (empty o))
312 ((invoke-output o "text") "finger" s))
316 ((invoke-output o "text") "huge" s))
320 ((invoke-output o "text") "italic" s))
324 ((invoke-output o "text") "large" s))
328 ((invoke-output o "text") "Large" s))
332 ((invoke-output o "text") "number" s))
336 ((invoke-output o "text") "text" s))
340 ((invoke-output o "text") "typewriter" s))
344 ((invoke-output o "slur") l))
349 (apply string-append (map control->string l))
354 (embedded-ps-tex (slur-ps l)))
357 (stem o kern width height depth)
358 ((invoke-output o "stem") kern width height depth))
361 (stem-ps kern width height depth)
362 (string-append (numbers->string (list kern width height depth))
366 (stem-tex kern width height depth)
368 "\\kern" (number->dim-tex kern)
369 "\\vrule width " (number->dim-tex width)
370 "depth " (number->dim-tex depth)
371 "height " (number->dim-tex height) " "))
375 ((invoke-output o "start-line")))
391 ((invoke-output o "invoke-dim1") "startrepeat" h))
395 ((invoke-output o "stop-line")))
407 ((invoke-output o "invoke-dim1") "stoprepeat" h))
411 (string-append "(" s ") set" f " "))
415 (string-append "\\set" f "{" s "}"))
419 "/fontA { /feta20 findfont 12 scalefont setfont} bind def fontA\n")
423 "\\font\\fontA=feta20.afm\\fontA\n")
426 (urg-font-switch-ps i)
427 "\n/feta20 findfont 12 scalefont setfont \n")