Short version: I made some changes to output-ps.scm
that can safely reduce the file size of ps files. In
a simple experiment, I was able to reduce non-binary
ps-code by up to 10%. I also don't know if anyone
cares! (: See the attachment.
- Mark
Long version (sorry this is so long):
LilyPond generates postscript files with needless precision:
1.1267 0.0000 /d
1.1950 0.0000 /n
0.9902 0.0000 /o
1.2633 0.0000 /P
But I was able to tweak output-ps.scm to generate this:
1.1267 0 /d
1.195 0 /n
0.9902 0 /o
1.2633 0 /P
The reason is that output-ps procedures generally use the
form (ly:format "~4f" x). For example:
(define (placebox x y s)
(ly:format "~4f ~4f moveto\n~a\n" x y s))
First I defined my own format:
(define (set-precision n)
(if (number? n)
(let* ((max-decimals 4)
(k (expt 10.0 max-decimals))
(float (/ (round (* n k))
k)))
(if (integer? n)
(inexact->exact n)
(if (< (abs (- float (round n)))
(/ 0.1 k))
(inexact->exact (round float))
float)))
n))
(define (ly:format4 string . args)
(apply format string (map set-precision args)))
A major benefit of this format is that strings and
numbers can both be processed with "~a". So that
(ly:format4 "~a ~a" "my string" 3.14159265358979)
yields "my string 3.1416".
Then I substituted the form (ly:format4 "~a" x) where I
could. For example:
(define (placebox x y s)
(ly:format4 "~a ~a moveto\n~a\n" x y s))
This worked! But there remained procedures which used the
form (ly:format "~4l" list-of-args), which my ly:format4
procedure could not recognize. It seems the "~l" construct
was born around line 493 of general-scheme.cc, but since
I'm not a C++ guy, I solved it with scheme instead.
If all args were already known, I just broke it up like so:
(ly:format4 "~a ~a ~a" arg1 arg2 arg3)
For example:
(define (dot x y radius)
(ly:format "~4l draw_dot" (list radius x y)))
...became...
(define (dot x y radius)
(ly:format4 "~a ~a ~a draw_dot" radius x y))
If the number of args is determined on-the-fly, I used this:
(ly:format "~{~a ~}" (map set-precision list-of-args))
So this:
(define (bezier-sandwich lst thick)
(ly:format "~l ~4f draw_bezier_sandwich"
(map number-pair->string4 lst)
thick))
...became this:
(define (bezier-sandwich lst thick)
(ly:format4 "~{~a ~}~a draw_bezier_sandwich"
(map number-pair->string4 (map set-precision lst))
thick))
____________________________________________________________
Then I compared the sizes of postscript files generated by
these two versions of output-ps.scm.
Well actually, I removed all of the binary data, ps varaiables
and music-drawing-routines.ps stuff before measuring. So each
stripped file now starts with:
%%Page: 1 1
%%BeginPageSetup
%%EndPageSetup
I used the Bach Invention no.13 from mutopia as a test file.
Here are the results (in bytes):
point-and-click off:
original "output-ps.scm" ==> 174,137
modified "output-ps.scm" ==> 157,515
point-and-click on:
original "output-ps.scm" ==> 299,460
modified "output-ps.scm" ==> 282,517
So with point-and-click off, the file size was reduced by
almost 10% using the modified output-ps. With point-and-click
on, the size was reduced only about 5.5%.
I don't know if anybody cares about this. I've attached the
modified file.
Here are some more questions/observations.
Man, this postis long. Sorry.
____________________________________________________________
There's a procedure named glyph-string which has some
internal parameters that I don't fully understand. Actually,
I don't need to understand them, I just would like to if
they can safely be restricted to 4 decimal places if they
are numbers.
Are there any numeric parameters that need to remain
unformatted? I can't imagine why there would be. To my
untrained eye, it looks like it would be safe to call
ly:format4 on any arg here.
Also, in the grob-cause procedure, I found these lines:
(music-origin (if (ly:stream-event? cause)
(ly:event-property cause 'origin))))
Is it okay that the if expr is missing an alternate case?
What is music-origin if (ly:stream-event? cause) ==> #f ?
____________________________________________________________
I also found 2 procedures which are *never* called anywhere in
LilyPond: str4 and char
grep "str4" and you'll see its only occurence is in
output-ps.scm. grep "(char " - with the space - and you'll see
the function is defined twice (also in scm/output-svg.scm) but
never used again (as far as I can tell). I also checked
"map char " but I could be missing something. I don't know how
to ignore C++ headers and files when grepping. Do we need to
keep these?
____________________________________________________________
;;;; output-ps.scm -- implement Scheme output interface for PostScript
;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 1998--2009 Jan Nieuwenhuizen <jann...@gnu.org>
;;;; Han-Wen Nienhuys <han...@xs4all.nl>
;;;; Note: currently misused as testbed for titles with markup, see
;;;; input/test/title-markup.ly
;;;;
;;;; TODO:
;;;; * %% Papersize in (header ...)
;;;; * text setting, kerning.
;;;; * document output-interface
(define-module (scm output-ps)
#:re-export (quote)
;; JUNK this -- see lily.scm: ly:all-output-backend-commands
#:export (unknown
bezier-sandwich
char
circle
comment
dashed-line
dashed-slur
dot
draw-line
ellipse
embedded-ps
named-glyph
no-origin
oval
placebox
polygon
repeat-slash
resetcolor
resetrotation
round-filled-box
setcolor
setrotation
text
))
(use-modules (guile)
(ice-9 regex)
(srfi srfi-1)
(srfi srfi-13)
(scm framework-ps)
(lily))
;;; helper functions, not part of output interface
;;;
;; ice-9 format uses a lot of memory
;; using simple-format almost halves lilypond cell usage
(define (set-precision n)
(if (number? n)
(let* ((max-decimals 4)
(k (expt 10.0 max-decimals))
(float (/ (round (* n k))
k)))
(if (integer? n)
(inexact->exact n)
(if (< (abs (- float (round n)))
(/ 0.1 k))
(inexact->exact (round float))
float)))
n))
(define (ly:format4 string . args)
(apply format string (map set-precision args)))
;; It seems this procedure is never called. -MSP
;; Do we need to keep it?
(define (str4 num)
(if (or (nan? num) (inf? num))
(begin
(ly:warning (_ "Found infinity or nan in output. Substituting 0.0"))
(if (ly:get-option 'strict-infinity-checking)
(exit 1))
"0.0")
(ly:number->string num)))
(define (number-pair->string4 numpair)
(ly:format4 "~a ~a" (car numpair)
(cdr numpair)))
;;;
;;; Lily output interface, PostScript implementation --- cleanup and docme
;;;
;; two beziers
(define (bezier-sandwich lst thick)
(ly:format4 "~{~a ~}~a draw_bezier_sandwich"
(map number-pair->string4 (map set-precision lst))
thick))
;; It seems this procedure is never called. -MSP
;; Do we need to keep it?
(define (char font i)
(ly:format "~a (\\~a) show"
(ps-font-command font)
(ly:inexact->string i 8)))
(define (circle radius thick fill)
(ly:format4 "~a ~a ~a draw_circle"
(if fill "true" "false")
radius
thick))
(define (dashed-line thick on off dx dy phase)
(ly:format4 "~a ~a ~a [ ~a ~a ] ~a draw_dashed_line"
dx
dy
thick
on
off
phase))
;; what the heck is this interface ?
(define (dashed-slur thick on off l)
(ly:format4
"~{~a ~}~a [ ~a ~a ] 0 draw_dashed_slur"
(let ((control-points (append (cddr l)
(list (car l)
(cadr l)))))
(map number-pair->string4 (map set-precision control-points)))
thick
on
off))
(define (dot x y radius)
(ly:format4 "~a ~a ~a draw_dot" radius x y))
(define (draw-line thick x1 y1 x2 y2)
(ly:format4 "~a ~a ~a ~a ~a draw_line"
(- x2 x1)
(- y2 y1)
x1
y1
thick))
(define (ellipse x-radius y-radius thick fill)
(ly:format4 "~a ~a ~a ~a draw_ellipse"
(if fill "true" "false")
x-radius
y-radius
thick))
(define (embedded-ps string)
string)
(define (glyph-string postscript-font-name
size
cid?
w-x-y-named-glyphs)
(define (glyph-spec w x y g)
(let ((prefix (if (string? g)
"/"
"")))
;; I'm pretty sure it's safe to use ly:format4 -MSP
(ly:format4 "~a ~a ~a~a"
(+ w x)
y
prefix
g)))
;; I'm pretty sure it's safe to use ly:format4 -MSP
(ly:format4
(if cid?
(string-append "/~a /CIDFont findresource ~a"
"output-scale div scalefont setfont\n"
"~a\n"
"~a print_glyphs")
(string-append "/~a ~a output-scale div selectfont\n"
"~a\n"
"~a print_glyphs"))
postscript-font-name
size
(string-join (map (lambda (x) (apply glyph-spec x))
(reverse w-x-y-named-glyphs))
"\n")
(length w-x-y-named-glyphs)))
(define (grob-cause offset grob)
(if (ly:get-option 'point-and-click)
(let* ((cause (ly:grob-property grob 'cause))
(music-origin (if (ly:stream-event? cause)
(ly:event-property cause 'origin)
;; why no alternate value here? -MSP
)))
(if (ly:input-location? music-origin)
(let* ((location
(ly:input-file-line-char-column music-origin))
(raw-file (car location))
(file (if (is-absolute? raw-file)
raw-file
(string-append (ly-getcwd)
"/"
raw-file)))
(x-ext (ly:grob-extent grob grob X))
(y-ext (ly:grob-extent grob grob Y)))
(if (and (< 0 (interval-length x-ext))
(< 0 (interval-length y-ext)))
(ly:format4
"~a ~a ~a ~a (textedit://~a:~a:~a:~a) mark_URI\n"
(+ (car offset) (car x-ext))
(+ (cdr offset) (car y-ext))
(+ (car offset) (cdr x-ext))
(+ (cdr offset) (cdr y-ext))
;; TODO - full escaping.
;; backslash is interpreted by GS.
(ly:string-substitute
"\\" "/" (ly:string-substitute " " "%20" file))
(cadr location)
(caddr location)
(cadddr location))
""))
""))
""))
(define (named-glyph font glyph)
(ly:format4 "~a /~a glyphshow" ;; removed space at the end -MSP
(ps-font-command font)
glyph))
(define (no-origin)
"")
(define (oval x-radius y-radius thick fill)
(ly:format4 "~a ~a ~a ~a draw_oval"
(if fill "true" "false")
x-radius
y-radius
thick))
(define (placebox x y s)
(ly:format4 "~a ~a moveto\n~a\n" x y s))
(define (polygon points blot-diameter filled?)
(ly:format4 "~a ~{~a ~}~a ~a draw_polygon"
(if filled? "true" "false")
(map set-precision points)
(+ -1 (* 1/2 (length points)))
blot-diameter))
(define (repeat-slash width slope beam-thickness)
(define (euclidean-length x y)
(sqrt (+ (* x x) (* y y))))
(let ((x-width (euclidean-length beam-thickness
(/ beam-thickness slope)))
(height (* width slope)))
(ly:format4 "~a ~a ~a draw_repeat_slash"
x-width
width
height)))
(define (round-filled-box left right bottom top blotdiam)
(let* ((halfblot (/ blotdiam 2))
(x (- halfblot left))
(width (- right (+ halfblot x)))
(y (- halfblot bottom))
(height (- top (+ halfblot y))))
(ly:format4 "~a ~a ~a ~a ~a draw_round_box"
width
height
x
y
blotdiam)))
;; save current color on stack and set new color
(define (setcolor r g b)
(ly:format4 "gsave ~a ~a ~a setrgbcolor\n" r g b))
;; restore color from stack
(define (resetcolor) "grestore\n")
;; rotation around given point
(define (setrotation ang x y)
(ly:format4 "gsave ~a ~a translate ~a rotate ~a ~a translate\n"
x
y
ang
(* -1 x)
(* -1 y)))
(define (resetrotation ang x y)
"grestore ")
(define (text font s)
;; (ly:warning (_ "TEXT backend-command encountered in Pango backend"))
;; (ly:warning (_ "Arguments: ~a ~a"" font str))
(let* ((space-length (cdar (ly:text-dimension font " ")))
(space-move (string-append (number->string space-length)
;; changed 0.0 to 0 -MSP
" 0 rmoveto "))
(out-vec (decode-byte-string s)))
(string-append
(ps-font-command font)
" "
(string-join
(vector->list
(vector-for-each
(lambda (sym)
(if (eq? sym 'space)
space-move
(string-append "/"
(symbol->string sym)
" glyphshow")))
out-vec))))))
(define (unknown)
"\n unknown\n")
(define (url-link url x y)
(ly:format4
(string-append "~a ~a currentpoint vector_add "
"~a ~a currentpoint vector_add (~a) mark_URI")
(car x)
(car y)
(cdr x)
(cdr y)
url))
(define (utf-8-string pango-font-description string)
(ly:warning (_ "utf-8-string encountered in PS backend")))
(define (path thickness exps)
(define (convert-path-exps exps)
(if (pair? exps)
(let* ((head (car exps))
(rest (cdr exps))
(arity
(cond
((memq head '(rmoveto rlineto lineto moveto)) 2)
((memq head '(rcurveto curveto)) 6)
(else 1)))
(args (take rest arity)))
;; WARNING: this is a vulnerability:
;; a user can output arbitrary PS code here.
(cons (ly:format4 "~{~a ~}~a "
(map set-precision args)
head)
(convert-path-exps (drop rest arity))))
'()))
(ly:format4 "1 setlinecap ~a setlinewidth\n~{~a ~} stroke"
thickness
(map set-precision (convert-path-exps exps))))_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-devel
