;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;; Note: currently misused as testbed for titles with markup, see
;;;; input/test/title-markup.ly
;;;
+;; ice-9 format uses a lot of memory
+;; using simple-format almost halves lilypond cell usage
+(define format simple-format)
+
(define (escape-parentheses s)
(regexp-substitute/global #f "(^|[^\\])([\\(\\)])" s 'pre 1 "\\" 2 'post))
-(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)))
+ (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)
- (format #f "~f ~f" (round4 (car numpair)) (round4 (cdr numpair))))
+ (string-append (str4 (car numpair))
+ " "
+ (str4 (cdr numpair))))
(define (numbers->string4 numlist)
(string-join (map str4 numlist) " "))
(define (circle radius thick fill)
(format #f
- "~a ~f ~f draw_circle"
+ "~a ~a ~a draw_circle"
(if fill
"true"
"false")
- (round4 radius) (round4 thick)))
+ (str4 radius) (str4 thick)))
(define (dashed-line thick on off dx dy phase)
(format #f "~a ~a ~a [ ~a ~a ] ~a draw_dashed_line"
(define (glyph-spec w x y g)
(let ((prefix (if (string? g) "/" "")))
- (format #f "~f ~f ~a~a"
- (round2 (+ w x))
- (round2 y)
+ (format #f "~a ~a ~a~a"
+ (str4 (+ w x))
+ (str4 y)
prefix g)))
(format #f
(if (and (< 0 (interval-length x-ext))
(< 0 (interval-length y-ext)))
- (format #f "~$ ~$ ~$ ~$ (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))
+ (format #f "~a ~a ~a ~a (textedit://~a:~a:~a:~a) mark_URI\n"
+ (str4 (+ (car offset) (car x-ext)))
+ (str4 (+ (cdr offset) (car y-ext)))
+ (str4 (+ (car offset) (cdr x-ext)))
+ (str4 (+ (cdr offset) (cdr y-ext)))
;; TODO
;;full escaping.
;; backslash is interpreted by GS.
- (string-regexp-substitute "\\\\" "/"
- (string-regexp-substitute " " "%20" file))
+ (ly:string-substitute "\\" "/"
+ (ly:string-substitute " " "%20" file))
(cadr location)
(caddr location)
(cadddr location))
;; rotation around given point
(define (setrotation ang x y)
- (format "gsave ~a translate ~a rotate ~a translate\n"
+ (format #f "gsave ~a translate ~a rotate ~a translate\n"
(numbers->string4 (list x y))
(number->string ang)
(numbers->string4 (list (* -1 x) (* -1 y)))))
"\n unknown\n")
(define (url-link url x y)
- (format #f "~$ ~$ ~$ ~$ (~a) mark_URI"
+ (format #f "~a ~a ~a ~a (~a) mark_URI"
(car x)
(car y)
(cdr x)
)
;; WARNING: this is a vulnerability: a user can output arbitrary PS code here.
- (cons (format "~a ~a "
- (string-join (map (lambda (x) (format "~a " x)) args) " ")
+ (cons (format #f
+ "~a ~a "
+ (string-join (map (lambda (x) (format #f "~a " x)) args) " ")
head)
(convert-path-exps (drop rest arity))))
'()))
- (format
+ (format #f
"1 setlinecap ~a setlinewidth\n~a stroke"
thickness
(string-join (convert-path-exps exps) " ")))