I sent this some hours ago, but haven't seen it yet. Is the mailing list broken, or just really slow?
Original message: I made some changes to the Postscript backend, making the output more readable (especially for text), around 10% shorter, and, at least in theory, also faster to interpret. These changes are just a start, but I hope they help. I'd like to know if it might be possible to make the backend work at a slightly higher level, which should allow much smaller files (e.g., Postscript could easily understand the concept of "filled dotted quarter note in current note font with upward stem 3 staff spaces long"). I'm not a master of diff, so let me know if the following aren't done right. Diffs (made with -u) against the 2.8.0 source: --- ../Installation Programs/lilypond-2.8.0-src/lilypond-2.8.0/scm/framework-ps.scm 2006-03-20 19:45:18.000000000 -0500 +++ framework-ps.scm 2006-03-25 18:25:43.875475200 -0500 @@ -42,8 +42,10 @@ (define font-list (ly:paper-fonts paper)) (define (define-font command fontname scaling) (string-append - "/" command " { /" fontname " findfont " - (ly:number->string scaling) " output-scale div scalefont } bind def\n")) + "/" command " { /" fontname " " (ly:number->string scaling) " output-scale div selectfont } bind def\n")) +; (string-append +; "/" command " { /" fontname " findfont " +; (ly:number->string scaling) " output-scale div scalefont } bind def\n")) (define (standard-tex-font? x) (or (equal? (substring x 0 2) "ms") --- ../Installation Programs/lilypond-2.8.0-src/lilypond-2.8.0/ps/music-drawing-routines.ps 2006-03-16 05:52:27.000000000 -0500 +++ music-drawing-routines.ps 2006-03-25 18:25:10.447408000 -0500 @@ -241,10 +241,7 @@ % JUNKME: Use color. /draw_white_text % text scale font { - %font - findfont - %scale - exch scalefont setfont + exch selectfont 1 setgray 0 0 moveto %-0.05 -0.05 moveto @@ -276,5 +273,19 @@ stroke } bind def +/printletter { + currentpoint + 3 2 roll + glyphshow + moveto +} bind def +/printglyphs { + -1 1 + { + 3 mul -3 roll + printletter + rmoveto + }for +}bind def %end music-drawing-routines.ps --- ../Installation Programs/lilypond-2.8.0-src/lilypond-2.8.0/scm/output-ps.scm 2006-03-07 13:14:23.000000000 -0500 +++ output-ps.scm 2006-03-25 18:25:34.061363200 -0500 @@ -54,6 +54,21 @@ (define (ps-encoding text) (escape-parentheses text)) +(define (round2 num) + (/ (round (* 100 num)) 100)) + +(define (round4 num) + (/ (round (* 10000 num)) 10000)) + +(define (str4 num) + (format #f "~f" (round4 num))) + +(define (number-pair->string4 numpair) + (format #f "~f ~f" (round4 (car numpair)) (round4 (cdr numpair)))) + +(define (numbers->string4 numlist) + (apply string-append (map (lambda (x) (string-append (str4 x) " ")) numlist))) + ;; FIXME: lily-def (define-public (ps-string-def prefix key val) (string-append "/" prefix (symbol->string key) " (" @@ -75,59 +90,61 @@ ;; two beziers (define (bezier-sandwich lst thick) (string-append - (string-join (map ly:number-pair->string lst) " ") + (string-join (map number-pair->string4 lst) " ") " " - (ly:number->string thick) + (str4 thick) " draw_bezier_sandwich")) (define (char font i) (string-append - (ps-font-command font) " setfont " - "(\\" (ly:inexact->string i 8) ") show")) + (ps-font-command font) ; " " + " (\\" (ly:inexact->string i 8) ") show")) (define (circle radius thick fill) (format - "~a ~a ~a draw_circle" radius thick + "~f ~f ~a draw_circle" (round4 radius) (round4 thick) (if fill "true " "false "))) (define (dashed-line thick on off dx dy) (string-append - (ly:number->string dx) " " - (ly:number->string dy) " " - (ly:number->string thick) + (str4 dx) " " + (str4 dy) " " + (str4 thick) " [ " - (ly:number->string on) " " - (ly:number->string off) + (str4 on) " " + (str4 off) " ] 0 draw_dashed_line")) ;; what the heck is this interface ? (define (dashed-slur thick on off l) (string-append - (string-join (map ly:number-pair->string l) " ") + (string-join (map number-pair->string4 l) " ") " " - (ly:number->string thick) + (str4 thick) " [ " - (ly:number->string on) + (str4 on) " " - (ly:number->string off) + (str4 off) " ] 0 draw_dashed_slur")) +;; s/\.\([0-9]\{-}\)0* /\1 /g + (define (dot x y radius) (string-append " " - (ly:numbers->string + (numbers->string4 (list x y radius)) " draw_dot")) (define (draw-line thick x1 y1 x2 y2) (string-append "1 setlinecap 1 setlinejoin " - (ly:number->string thick) " setlinewidth " - (ly:number->string x1) " " - (ly:number->string y1) " moveto " - (ly:number->string x2) " " - (ly:number->string y2) " lineto stroke")) + (str4 thick) " setlinewidth " + (str4 x1) " " + (str4 y1) " moveto " + (str4 x2) " " + (str4 y2) " lineto stroke")) (define (embedded-ps string) string) @@ -138,12 +155,10 @@ w-x-y-named-glyphs) (format #f "gsave - /~a ~a ~a output-scale div scalefont setfont\n~a grestore" + /~a ~a output-scale div selectfont\n~a grestore" postscript-font-name - (if cid? - " /CIDFont findresource " - " findfont") size + (string-append (apply string-append (map (lambda (item) @@ -154,9 +169,12 @@ (g (cadddr item)) (prefix (if (string? g) "/" ""))) - (format #f " gsave ~a~a glyphshow grestore ~$ ~$ rmoveto \n" prefix g (+ w x) y) + (format #f "~f ~f ~a~a\n" (round2 (+ w x)) + (round2 y) prefix g) )) - w-x-y-named-glyphs)))) + w-x-y-named-glyphs)) + (format #f "~a printglyphs" (length w-x-y-named-glyphs))) + )) (define (grob-cause offset grob) (let* ((cause (ly:grob-property grob 'cause)) @@ -201,7 +219,7 @@ (define (named-glyph font glyph) (string-append - (ps-font-command font) " setfont " + (ps-font-command font) " " "/" glyph " glyphshow ")) (define (no-origin) @@ -214,21 +232,21 @@ ~a grestore\n" - (ly:number->string x) - (ly:number->string y) + (str4 x) + (str4 y) s)) (define (polygon points blot-diameter filled?) (string-append - (ly:numbers->string points) " " - (ly:number->string (/ (length points) 2)) " " - (ly:number->string blot-diameter) + (numbers->string4 points) " " + (str4 (/ (length points) 2)) " " + (str4 blot-diameter) (if filled? " true " " false ") " draw_polygon")) (define (repeat-slash wid slope thick) (string-append - (ly:numbers->string (list wid slope thick)) + (numbers->string4 (list wid slope thick)) " draw_repeat_slash")) ;; restore color from stack @@ -237,13 +255,13 @@ (define (round-filled-box x y width height blotdiam) (string-append - (ly:numbers->string + (numbers->string4 (list x y width height blotdiam)) " draw_round_box")) ;; save current color on stack and set new color (define (setcolor r g b) (string-append "currentrgbcolor " - (ly:numbers->string (list r g b)) + (numbers->string4 (list r g b)) " setrgbcolor\n")) (define (text font s) @@ -256,7 +274,7 @@ (out-vec (decode-byte-string s))) (string-append - (ps-font-command font) " setfont " + (ps-font-command font) " " (string-join (vector->list (vector-for-each @@ -286,10 +304,10 @@ (define (zigzag-line centre? zzw zzh thick dx dy) (string-append (if centre? "true" "false") " " - (ly:number->string zzw) " " - (ly:number->string zzh) " " - (ly:number->string thick) " " + (str4 zzw) " " + (str4 zzh) " " + (str4 thick) " " "0 0 " - (ly:number->string dx) " " - (ly:number->string dy) + (str4 dx) " " + (str4 dy) " draw_zigzag_line")) _______________________________________________ lilypond-devel mailing list lilypond-devel@gnu.org http://lists.gnu.org/mailman/listinfo/lilypond-devel