release: 1.3.0

[lilypond.git] / scm / lily.scm

diff --git a/scm/lily.scm b/scm/lily.scm
index 26920e72b192ab7b22cb5cb290dffd5993f0394d..de499111543ca35a3d04fc2d47424ef10d70410f 100644 (file)
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -8,6 +8,9 @@
 ;(debug-enable 'backtrace)
 
 ;;; library funtions
+
+; :use-module (ice-9 regex))
+
 (define
   (xnumbers->string l)
   (string-append 
@@ -176,9 +179,8 @@
 
   (define (select-font font-name magnification)
       (if (not (equal? font-name current-font))
-         (begin
+         (let* ((font-cmd (assoc font-name font-alist)))
            (set! current-font font-name)
-           (define font-cmd (assoc font-name font-alist))
            (if (eq? font-cmd #f)
                (begin
                  (set! font-cmd (cached-fontname font-count))
@@ -234,9 +236,14 @@
     (string-append
      "\\font" (font-switch i) "=" s "\n"))
 
-  ;; UGH
-   
-  (define (header-end) "\\turnOnPostScript")
+  (define (header-end)
+    (string-append
+     "\\special{! "
+     (ly-gulp-file "lily.ps")
+     ;; breaks on ppc
+;;     (regexp-substitute/global #f "\n" (ly-gulp-file "lily.ps") 'pre " %\n" 'post)
+     "}"
+     "\\input lilyponddefs \\turnOnPostScript"))
 
   (define (header creator generate) 
     (string-append
@@ -255,14 +262,18 @@
   ;;
   ;; need to do something to make this really safe.
   ;;
-  (if security-paranoia
-      (define (output-tex-string s)
-       (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post))
-      (define (output-tex-string s)    s))
+  (define (output-tex-string s)
+      (if security-paranoia
+         (regexp-substitute/global #f "\\\\" s 'pre "$\\backslash$" 'post)
+         s))
+      
 
   (define (lily-def key val)
     (string-append
-     "\\def\\" (output-tex-string key) "{" (output-tex-string val) "}\n"))
+     "\\def\\"
+;     (regexp-substitute/global #f "_" (output-tex-string key) 'pre "X" 'post)
+     (output-tex-string key)
+     "{" (output-tex-string val) "}\n"))
 
   (define (number->dim x)
     (string-append 
@@ -405,20 +416,20 @@
                      )))
   
   (define (select-font font-name magnification)
-      (if (not (equal? font-name current-font))
-         (begin
-           (set! current-font font-name)
-           (define font-cmd (assoc font-name font-alist))
-           (if (eq? font-cmd #f)
-               (begin
-                 (set! font-cmd (cached-fontname font-count))
-                 (set! font-alist (acons font-name font-cmd font-alist))
-                 (set! font-count (+ 1 font-count))
-                 (string-append "\n/" font-cmd " {/"
-                                font-name " findfont " 
-                                (mag-to-size magnification)
-                                " scalefont setfont} bind def \n"
-                                font-cmd " \n"))
+    (define font-cmd (assoc font-name font-alist))
+    (if (not (equal? font-name current-font))
+       (begin
+         (set! current-font font-name)
+         (if (eq? font-cmd #f)
+             (begin
+               (set! font-cmd (cached-fontname font-count))
+               (set! font-alist (acons font-name font-cmd font-alist))
+               (set! font-count (+ 1 font-count))
+               (string-append "\n/" font-cmd " {/"
+                              font-name " findfont " 
+                              (mag-to-size magnification)
+                              " scalefont setfont} bind def \n"
+                              font-cmd " \n"))
                (string-append (cdr font-cmd) " ")))
          ; font-name == current-font no switch needed
          ""                            
@@ -444,7 +455,10 @@
      (apply string-append (map control->string l)) 
      (number->string thick) 
      " [ "
-     (if (> 1 dash) (number->string (- (* thick dash) thick)) "0") " "
+     (if (> 1 dash)
+        (number->string (- (* thick dash) thick))
+        "0")
+     " "
      (number->string (* 2 thick))
      " ] 0 draw_dashed_slur"))
 
@@ -473,7 +487,14 @@
   (define (font-switch i)
     (string-append (font i) " "))
 
-  (define (header-end) "")
+  (define (header-end)
+    (string-append
+     (ly-gulp-file "lilyponddefs.ps")
+     " {exch pop //systemdict /run get exec} "
+     (ly-gulp-file "lily.ps")
+     "{ exch pop //systemdict /run get exec } "
+    ))
+  
   (define (lily-def key val)
 
      (if (string=? (substring key 0 (min (string-length "mudelapaper") (string-length key))) "mudelapaper")