From: Han-Wen Nienhuys Date: Wed, 17 Jan 2007 14:53:10 +0000 (+0100) Subject: Reduces memory load by factor 2. X-Git-Tag: release/2.10.12-1~4 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=51395ea21030bd7975d03eb8ffbc5814f84b0f72;p=lilypond.git Reduces memory load by factor 2. Do this by using simple-format iso. format for formatting output. Conflicts: scm/output-ps.scm --- diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index a2caf4002e..14631f7f5b 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -8,9 +8,7 @@ ;;; this is still too big a mess. -(use-modules (ice-9 regex) - (ice-9 string-fun) - (ice-9 format) +(use-modules (ice-9 string-fun) (guile) (scm page) (scm paper-system) @@ -19,6 +17,10 @@ (scm clip-region) (lily)) +(define (format dest . rest) + (if (string? dest) + (apply simple-format (cons #f (cons dest rest))) + (apply simple-format (cons dest rest)))) (define framework-ps-module (current-module)) @@ -31,7 +33,12 @@ (string-append "magfont" - (string-regexp-substitute "[ /%]" "_" name) + (ly:string-substitute + " " "_" + (ly:string-substitute + "/" "_" + (ly:string-substitute + "%" "_" name))) "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))))) (define (tex-font? fontname) @@ -165,10 +172,10 @@ (ly:output-def-lookup paper 'output-scale)) (ly:bp 1))) (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))) - (format "%%DocumentMedia: ~a ~$ ~$ ~a ~a ~a\n" + (format "%%DocumentMedia: ~a ~a ~a ~a ~a ~a\n" (ly:output-def-lookup paper 'papersizename) - (if landscape? h w) - (if landscape? w h) + (round2 (if landscape? h w)) + (round2 (if landscape? w h)) 80 ;; weight "()" ;; color "()" ;; type @@ -270,7 +277,10 @@ (if (mac-font? bare-file-name) (handle-mac-font name bare-file-name) (cond - ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name) + ((or (string-startswith file-name "Emmentaler") + (string-startswith file-name "emmentaler") + (string-startswith file-name "aybabtu") + (string-startswith file-name "Aybabtu")) (ps-load-file (ly:find-file (format "~a.otf" file-name)))) ((string? bare-file-name) @@ -337,13 +347,13 @@ ((downcase-file-name (string-downcase file-name))) (cond - ((and file-name (string-match "\\.pfa" downcase-file-name)) + ((and file-name (string-endswith downcase-file-name ".pfa")) (embed-document file-name)) - ((and file-name (string-match "\\.pfb" downcase-file-name)) + ((and file-name (string-endswith downcase-file-name ".pfb")) (ly:pfb->pfa file-name)) - ((and file-name (string-match "\\.ttf" downcase-file-name)) + ((and file-name (string-endswith downcase-file-name ".ttf")) (ly:ttf->pfa file-name)) - ((and file-name (string-match "\\.otf" downcase-file-name)) + ((and file-name (string-endswith downcase-file-name ".otf")) (ps-embed-cff (ly:otf->cff file-name) name 0)) (else (ly:warning (_ "don't know how to embed ~S=~S") name file-name) @@ -354,7 +364,7 @@ (eq? PLATFORM 'darwin) bare-file-name (or - (string-match "\\.dfont" bare-file-name) + (string-endswith bare-file-name ".dfont") (= (stat:size (stat bare-file-name)) 0)))) (define (load-font font-name-filename) diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 741a74f73d..2db81d30ce 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -429,9 +429,16 @@ found." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - - +;; string + +(define-public (string-endswith s suffix) + (equal? prefix (substring s + (max 0 (- (string-length s)) + (min (string-length s) (string-length prefix)))))) + +(define-public (string-startswith s prefix) + (equal? prefix (substring s 0 (min (string-length s) (string-length prefix))))) + (define-public (string-encode-integer i) (cond ((= i 0) "o") @@ -522,6 +529,12 @@ possibly turned off." 0 (if (< x 0) -1 1))) +(define-public (round2 num) + (/ (round (* 100 num)) 100)) + +(define-public (round4 num) + (/ (round (* 10000 num)) 10000)) + (define-public (car< a b) (< (car a) (car b))) (define-public (symbolstring num))) (define (number-pair->string4 numpair) (format #f "~f ~f" (round4 (car numpair)) (round4 (cdr numpair)))) @@ -106,11 +107,11 @@ (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" @@ -154,9 +155,9 @@ (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 @@ -191,18 +192,18 @@ (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)) @@ -304,7 +305,7 @@ "\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)