Reduces memory load by factor 2.

Do this by using simple-format iso. format for formatting output.

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 4a4ae30b7a9145bed67632b08efa7197b11511c2..670e28e538d35cb053aee265af64a41c8124ce41 100644 (file)
--- 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 dc69ad5df74de3e5ebbd620ff679fb1e058caf4f..47e1bcd3cad5f3d5497b70717e5d368bdc285092 100644 (file)
--- 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 (symbol<? lst r)

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 42aecc1dbcb0364720adcb10a5bf687846a7bc3a..f1689c151894b63f0ccd22f8855370862a07ab63 100644 (file)
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -52,18 +52,13 @@
 ;;;
 
 
+;; 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)
   (if (or (nan? num) (inf? num))
       (begin
@@ -71,7 +66,7 @@
        (if (ly:get-option 'strict-infinity-checking)
            (exit 1))
        "0.0")
-      (format #f "~f" (round4 num))))
+      (ly:number->string 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)