1 ;;; pdf.scm -- implement Scheme output routines for PDF.
3 ;;; source file of the GNU LilyPond music typesetter
5 ;;; (c) 2001 Stephen Peters <portnoy@portnoy.org>
8 ;currently no font commands; this is a helper for pdftex.scm.
10 (define-module (scm pdf)
14 (define this-module (current-module))
22 ; simple commands to store and update currentpoint. This makes the
23 ; other procedures simple rewrites of the PostScript code.
24 (define currentpoint (cons 0 0))
26 (string-append (ly-number->string (car currentpoint)) " "
27 (ly-number->string (cdr currentpoint)) " "))
29 (set! currentpoint (cons x y))
30 (string-append (showcp) "m "))
31 (define (moveto-pair pair)
32 (moveto (car pair) (cdr pair)))
34 (moveto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
36 (set! currentpoint (cons x y))
37 (string-append (showcp) "l "))
38 (define (lineto-pair pair)
39 (lineto (car pair) (cdr pair)))
41 (lineto (+ x (car currentpoint)) (+ y (cdr currentpoint))))
42 (define (curveto x1 y1 x2 y2 x y)
43 (set! currentpoint (cons x y))
44 (string-append (ly-number->string x1) (ly-number->string y1)
45 (ly-number->string x2) (ly-number->string y2)
46 (ly-number->string x) (ly-number->string y) "c "))
47 (define (curveto-pairs pt1 pt2 pt)
48 (curveto (car pt1) (cdr pt1) (car pt2) (cdr pt2) (car pt) (cdr pt)))
49 (define (closefill) "h f ")
50 (define (closestroke) "S ")
51 (define (setlinewidth w) (string-append (ly-number->string w) "w "))
52 (define (setgray g) (string-append (ly-number->string g) "g "))
53 (define (setlineparams) "1 j 1 J ")
55 (define (beam width slope thick)
56 (let ((ht (* slope width)))
57 (string-append (moveto 0 (- (/ thick 2)))
60 (lineto 0 (/ thick 2))
64 (string-append "% " s "\n"))
66 (define (brack-traject pair ds alpha)
67 (let ((alpha-rad (* alpha (/ 3.141592654 180))))
68 (cons (+ (car pair) (* (cos alpha-rad) ds))
69 (+ (cdr pair) (* (sin alpha-rad) ds)))))
71 (define (bracket arch_angle arch_width arch_height height arch_thick thick)
72 (let* ((halfht (+ (/ height 2) thick))
73 (farpt (cons (+ thick arch_height)
74 (+ (- halfht arch_thick) arch_width)))
76 (string-append (moveto 0 0)
78 (lineto thick (- halfht arch_thick))
80 (brack-traject (cons thick
81 (- halfht arch_thick))
82 (* 0.4 arch_height) 0)
91 (brack-traject (cons (/ thick 2) halfht)
96 (string-append (setlinewidth (/ thick 2))
98 "q 1 0 0 -1 0 0 cm " ; flip coords
104 (invoke-char " show" i))
107 (define (dashed-slur thick dash l)
108 (string-append (setlineparams)
109 "[ " (ly-number->string dash) " "
110 (ly-number->string (* 10 thick)) " ] 0 d "
112 (moveto-pair (car l))
113 (apply curveto (cdr l))
116 (define (dashed-line thick on off dx dy)
117 (string-append (setlineparams)
118 "[ " (ly-number->string on) " "
119 (ly-number->string off) " ] 0 d "
125 (define (repeat-slash width slope beamthick)
126 (let* ((height (/ beamthick slope))
127 (xwid (sqrt (+ (* beamthick beamthick) (* height height)))))
128 (string-append (moveto 0 0)
130 (rlineto width (* slope width))
134 (define (end-output) "")
136 (define (experimental-on) "")
138 (define (filledbox breadth width depth height)
139 (string-append (ly-number->string (- breadth))
140 (ly-number->string (- depth))
141 (ly-number->string (+ breadth width))
142 (ly-number->string (+ depth height))
147 ;;(define (dot x y diam)
148 ;; (let (radius (/ diam 2))
149 ;; (string-append (ly-number->string (x))
150 ;; (ly-number->string (y))
151 ;; (ly-number->string (radius))
152 ;; " ??? "))) ;; how to draw a circle in PDF?
154 ;;(define (roundfilledbox x y width height blotdiam)
155 ;; (string-append " "
156 ;; (dot x y blotdiam)
157 ;; (dot (+ x width) y blotdiam)
158 ;; (dot (+ x width) (+ y height) blotdiam)
159 ;; (dot x (+ y height) blotdiam)
160 ;; (filledbox (+ x (/ blotdiam 2)) (+ width (/ blotdiam 2)) y height)
161 ;; (filledbox x width (+ y (/ blotdiam 2)) (+ height (/ blotdiam 2)))))
166 (define (roundfilledbox breadth width depth height blot)
167 (filledbox breadth width depth height))
170 (define (font-def i s) "")
172 (define (font-switch i) "")
174 (define (header-end) "")
176 (define (lily-def key val) "")
178 (define (header creator generate) "")
180 (define (invoke-char s i)
182 "(\\" (inexact->string i 8) ") " s " " ))
184 (define (placebox x y s) "")
186 ;; TODO: bezier-ending, see ps.scm
187 (define (bezier-bow l thick)
188 (bezier-sandwich l thick))
190 (define (bezier-sandwich l thick)
191 (string-append (setlinewidth thick)
192 (moveto-pair (list-ref l 7))
193 (curveto-pairs (list-ref l 4)
196 (lineto-pair (list-ref l 3))
197 (curveto-pairs (list-ref l 0)
202 (define (start-system height) "")
204 (define (stem breadth width depth height)
205 (filledbox breadth width depth height))
207 (define (stop-system) "")
212 (define (unknown) "\n unknown\n")
214 ; Problem here -- we're using /F18 for the font, but we don't know
215 ; for sure that that will exist.
216 (define (ez-ball ch letter-col ball-col)
217 (let ((origin (cons 0.45 0)))
218 (string-append (setgray 0)
220 (moveto-pair origin) (lineto-pair origin)
224 (moveto-pair origin) (lineto-pair origin)
230 "-0.28 -0.30 Td " ; move for text block
231 "[(" ch ")] TJ ET ")))
233 (define (define-origin a b c ) "")
234 (define (no-origin) "")
236 (define my-eval-in-module eval)
238 (if (or (equal? (minor-version) "4.1")
239 (equal? (minor-version) "4")
240 (equal? (minor-version) "3.4"))
241 (set! my-eval-in-module eval-in-module))
243 (define-public (pdf-output-expression expr port)
244 (display (my-eval-in-module expr this-module) port) )
248 ; scheme-program-name: "guile"