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"))
_________________________________________________________________
Dont just search. Find. Check out the new MSN Search!
http://search.msn.click-url.com/go/onm00200636ave/direct/01/
_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-devel
