1 ;;;; sodipodi.scm -- implement Scheme output routines for PostScript
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2002--2004 Jan Nieuwenhuizen <janneke@gnu.org>
9 ;;;; * Get mftrace 1.0.12 or newer to create the .pfa fonts:
14 ;;;; * Get sodipodi-0.28 or newer
16 ;;;; * Link/copy mf/out/private-fonts to ~/.sodipodi/private-fonts
18 ;;;; http://www.w3.org/TR/SVG11/paths.html
21 (debug-enable 'backtrace)
23 (define-module (scm output-sodipodi))
24 (define this-module (current-module))
30 ;;; Lily output interface --- cleanup and docme
32 ;;; Bare minimum interface for \score { \notes c } }
35 ;;; xx-output-expression
40 ;;; and should intercept:
52 ;;(define-public (sodipodi-output-expression expr port)
53 ;; (display (eval expr this-module) port))
55 (define-public (sodipodi-output-expression expr port)
56 (display (dispatch expr) port))
58 (define (dispatch expr)
59 (let ((keyword (car expr)))
61 ((eq? keyword 'some-func) "")
62 ;;((eq? keyword 'placebox) (dispatch (cadddr expr)))
64 (if (module-defined? this-module keyword)
65 (apply (eval keyword this-module) (cdr expr))
68 (string-append "undefined: " (symbol->string keyword) "\n"))
76 (define page-number 0)
78 ;;(define output-scale 2.83464566929134)
79 (define output-scale (* 2 2.83464566929134))
82 (define urg-line-thickness 0)
83 (define line-thickness 0.001)
84 (define half-lt (/ line-thickness 2))
89 ((equal? (ly:unit) "mm") (/ 72.0 25.4))
90 ((equal? (ly:unit) "pt") (/ 72.0 72.27))
91 (else (error "unknown unit" (ly:unit)))))
94 (define (tagify tag string . attribute-alist)
97 (apply string-append (map (lambda (x) (string-append
99 (symbol->string (car x))
105 string "\n</" tag ">\n"))
108 (define (ascii->string i) (make-string 1 (integer->char i)))
109 (define (ascii->upm-string i)
112 (u2 (+ #x80 (quotient i+1 #x40)))
113 (u3 (+ #x80 (modulo i+1 #x40))))
118 (define (control->list c)
119 (list (car c) (cdr c)))
121 (define (control->string c)
123 (number->string (car c)) ","
125 (number->string (* -1 (cdr c))) " "))
127 (define (control-flip-y c)
128 (cons (car c) (* -1 (cdr c))))
130 (define (ly:numbers->string l)
132 (number->string (car l))
135 (string-append "," (ly:numbers->string (cdr l))))))
137 (define (svg-bezier l close)
138 (let* ((c0 (car (list-tail l 3)))
139 (c123 (list-head l 3)))
141 (if (not close) "M " "L ")
143 "C " (apply string-append (map control->string c123))
144 (if (not close) "" (string-append
145 "L " (control->string close))))));; " Z")))))
148 "<?xml version='1.0' standalone='no'?>
149 <!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 20010904//EN'
150 'http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd'
153 xmlns:xlink CDATA #FIXED 'http://www.w3.org/1999/xlink'>
162 sodipodi:version='0.26'
163 xmlns='http://www.w3.org/2000/svg'
164 xmlns:sodipodi='http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd'
165 xmlns:xlink='http://www.w3.org/1999/xlink'
168 sodipodi:docbase='/tmp/'
169 sodipodi:docname='/tmp/x'>
174 <g transform='translate(10,10) scale (1.0)'>
179 ;; Interface functions
184 ;; transform=scale and stroke don't play nice together...
185 (define (XXXbeam width slope thick)
188 (z (sqrt (+ (sqr x) (sqr y)))))
190 ;; '(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:0.1;stroke-linejoin:miter;stroke-linecap:butt;")
191 ;;'(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:0.000001;stroke-linejoin:miter;stroke-linecap:butt;")
192 `(style . ,(format "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:~f;stroke-linejoin:miter;stroke-linecap:butt;" line-thickness))
193 ;;`(x . ,(number->string half-lt))
195 ;;`(y . ,(number->string (- half-lt (/ thick 2))))
196 `(y . ,(number->string (- 0 (/ thick 2))))
197 `(width . ,(number->string width))
198 `(height . ,(number->string thick))
199 `(ry . ,(number->string half-lt))
200 `(transform . ,(format #f "matrix(~f,~f,0,1,0,0) scale (~f,~f)"
203 output-scale output-scale)))))
205 (define (beam width slope thick)
208 (z (sqrt (+ (sqr x) (sqr y)))))
210 `(style . ,(format "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:~f;stroke-linejoin:miter;stroke-linecap:butt;" line-thickness))
212 `(y . ,(number->string (* output-scale (- 0 (/ thick 2)))))
213 `(width . ,(number->string (* output-scale width)))
214 `(height . ,(number->string (* output-scale thick)))
215 `(ry . ,(number->string (* output-scale half-lt)))
216 `(transform . ,(format #f "matrix(~f,~f,0,1,0,0) scale (~f,~f)"
222 (define (bezier-sandwich l thick)
223 (let* (;;(l (eval urg-l this-module))
224 (first (list-tail l 4))
225 (first-c0 (car (list-tail first 3)))
226 (second (list-head l 4)))
228 `(stroke . "#000000")
229 `(stroke-width . ,(number->string line-thickness))
230 `(transform . ,(format #f "scale (~f,~f)"
231 output-scale output-scale))
232 `(d . ,(string-append (svg-bezier first #f)
233 (svg-bezier second first-c0))))))
235 (define (char font i)
237 (dispatch `(fontify ,font ,(ascii->upm-string i)))))
239 (define (nchar font i)
240 (format (current-error-port) "can't display char: ~x\n" i)
244 (string-append "<!-- " s " -->\n"))
246 (define (define-fonts layout font-list)
247 (comment (format #f "Fonts used: ~S" font-list)))
249 (define (filledbox breapth width depth height)
250 (round-filled-box breapth width depth height line-thickness))
253 "fill:black;stroke:none;text-anchor:start;writing-mode:lr;font-weight:normal;")
258 ("cmr8" . ,(string-append
260 "font-family:cmr;font-style:normal;font-size:8;"))
261 ("ecrm10" . ,(string-append
263 "font-family:ecmr;font-style:normal;font-size:10;"))
264 ("feta13" . ,(string-append
266 "font-family:LilyPond-Feta;font-style:-Feta;font-size:13;"))
267 ("feta-nummer10" . ,(string-append
269 "font-family:LilyPond-feta-nummer;font-style:-feta-nummer;font-size:10;"))
270 ("feta20" . ,(string-append
272 "font-family:LilyPond-feta;font-style:-feta;font-size:20;"))
273 ("parmesan20" . ,(string-append
275 "font-family:LilyPond-Parmesan;font-style:-Parmesan;font-size:20;"))))
277 (define (get-font font)
278 (let* ((name (ly:font-filename font))
279 (magnify (ly:font-magnification font)))
280 ;; name-mag-pair: (quote ("feta20" . 0.569055118110236))"feta20"(quote ("feta20" . 0.569055118110236))
281 (let ((font-string (assoc-get name font-alist)))
282 (if (not font-string)
284 (format #t "font not found: ~S\n" font)
285 (cdr (assoc "feta20" font-alist)))
289 (comment "header-end"))
291 (define (header creator time-stamp layout page-count- classic?)
298 ;; FIXME: duplicated in other output backends
299 ;; FIXME: silly interface name
300 (define (output-scopes layout scopes fields basename)
301 (format (current-error-port) "TODO: FIX ps/tex/interface\n"))
303 ;; FIXME: duplictates output-scopes, duplicated in other backends
304 ;; FIXME: silly interface name
305 (define (output-layout-def pd)
306 (format (current-error-port) "TODO: FIX ps/tex/interface\n"))
308 (define (lily-def key val)
310 ((equal? key "lilypondpaperoutputscale")
312 ;; If we just use transform scale (output-scale),
313 ;; all fonts come out scaled too (ie, much too big)
314 ;; So, we manually scale all other stuff.
315 (set! output-scale (* scale-to-unit (string->number val))))
316 ((equal? key "lilypondpaperlinethickness")
317 (set! urg-line-thickness (* scale-to-unit (string->number val)))))
324 (define (placebox x y expr)
333 (number->string (* output-scale x))
335 (number->string (- 0 (* output-scale y)))
338 (define (round-filled-box breapth width depth height blot-diameter)
340 ;;'(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;")
341 `(style . ,(format "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:~f;stroke-linejoin:miter;stroke-linecap:butt;" line-thickness))
342 `(x . ,(number->string (* output-scale (- 0 breapth))))
343 `(y . ,(number->string (* output-scale (- 0 height))))
344 `(width . ,(number->string (* output-scale (+ breapth width))))
345 `(height . ,(number->string (* output-scale (+ depth height))))
346 ;;`(ry . ,(number->string (* output-scale half-lt)))
347 `(ry . ,(number->string (/ blot-diameter 2)))))
351 ;; TODO: use height, set scaling?
352 (define (start-system origin dim)
353 ;;(define (start-system width height)
355 (set! system-y (+ system-y (cdr dim)))
358 (comment "start-system")
359 (format #f "<g transform='translate(0.0,~f)'>\n" (* output-scale y)))))
361 (define (stop-system last?)
364 (comment "stop-system")
367 (define (fontify font expr)
369 ;; (tagify "text" (dispatch expr) (cons 'style (get-font font)))))
370 (tagify "text" expr (cons 'style (get-font font)))))
372 (define (text font s)
375 (map (lambda (x) (ascii->upm-string (char->integer x)))
377 (cons 'style (get-font font))))
379 (define (ntext font s)
381 ;; to unicode or not?
382 (tagify "tspan" (dispatch `(fontify ,font ,s))))
385 (set! page-number (+ page-number 1))
386 (comment "start-page"))
388 (define (stop-page last?)
389 (comment "stop-page"))
391 ;; WTF is this in every backend?
392 (define (horizontal-line x1 x2 th)
393 ;; (draw-line th x1 0 x2 0))
394 (filledbox (- x1) (- x2 x1) (* .5 th) (* .5 th)))