From 65fba337cc28643505081d63d39afb2a547ec53f Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Wed, 17 Jan 2007 14:45:49 +0100 Subject: [PATCH] Reduces memory load by factor 2. Do this by using simple-format iso. format for formatting output. --- scm/framework-ps.scm | 36 +++++++++++++++++++++++------------- scm/lily-library.scm | 19 ++++++++++++++++--- scm/output-ps.scm | 41 ++++++++++++++++++----------------------- 3 files changed, 57 insertions(+), 39 deletions(-) diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 4a4ae30b7a..670e28e538 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 (_ "do not 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 dc69ad5df7..47e1bcd3ca 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -423,9 +423,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") @@ -516,6 +523,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) (string-append (str4 (car numpair)) @@ -114,11 +109,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" @@ -162,9 +157,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 @@ -199,18 +194,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)) @@ -312,7 +307,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) -- 2.39.2