(grob-cause): escape spaces in URLs.

[lilypond.git] / scm / output-ps.scm

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 6f8795915d6c74c91aefe9e001cef16c71ff79f6..e0bd54d9240c8a682109cbda33c8acc3815f2cc3 100644 (file)
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -21,8 +21,6 @@
            blank
            circle
            dot
-           white-dot
-           beam
            dashed-slur
            char
            setcolor
@@ -35,10 +33,8 @@
            placebox
            bezier-sandwich
            embedded-ps
-           filledbox
            round-filled-box
            text
-           white-text
            polygon
            draw-line
            no-origin))
@@ -76,11 +72,6 @@
 ;;; Lily output interface, PostScript implementation --- cleanup and docme
 ;;;
 
-;;; Output-interface functions
-(define (beam width slope thick blot)
-  (string-append
-   (ly:numbers->string (list slope width thick blot)) " draw_beam" ))
-
 ;; two beziers
 (define (bezier-sandwich lst thick)
   (string-append 
@@ -141,23 +132,35 @@
 (define (embedded-ps string)
   string)
 
-;; FIXME: use draw_round_box
-(define (filledbox breapth width depth height)
-  (string-append (ly:numbers->string (list breapth width depth height))
-                " draw_box"))
 
 (define (glyph-string
         postscript-font-name
         size cid?
         x-y-named-glyphs)
 
+  (define (encoding-vector-hack glyphs)
+    
+    ;; GS fucks up with glyphs that are not in the
+    ;; encoding vector.
+    (define (inner j glyphs)
+      (if (or (null? glyphs) (> j 256))
+         '()
+         (cons (format "dup ~a /~a put\n"
+                       j (car glyphs))
+               (inner (1+ j) (cdr glyphs)))))
+         
+    (format "256 array 0 1 255 { 1 index exch /.notdef put} for\n ~a
+/EncHack reencode-font /EncHack findfont"
+           (apply string-append (inner 32 glyphs))))
+    ;; END HACK.
+  
   (format #f "gsave 1 output-scale div 1 output-scale div scale
   /~a ~a ~a scalefont setfont\n~a grestore"
          postscript-font-name
          (if cid?
              " /CIDFont findresource "
-             " findfont") 
-         
+             " findfont")
+       
          size
          (apply
           string-append
@@ -183,7 +186,7 @@
                           (ly:music-property cause 'origin))))
     (if (not (ly:input-location? music-origin))
        ""
-       (let* ((location (ly:input-file-line-column music-origin))
+       (let* ((location (ly:input-file-line-char-column music-origin))
               (raw-file (car location))
               (file (if (is-absolute? raw-file)
                         raw-file
@@ -193,14 +196,18 @@
 
          (if (and (< 0 (interval-length x-ext))
                   (< 0 (interval-length y-ext)))
-             (format "~a ~a ~a ~a (textedit://~a:~a:~a) mark_URI\n"
+             (format "~a ~a ~a ~a (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))
-                     file
+
+                     ;; TODO
+                     ;; full escaping.
+                     (string-regexp-substitute " " "%20" file)
                      (cadr location)
-                     (caddr location))
+                     (caddr location)
+                     (cadddr location))
              "")))))
 
 (define (lily-def key val)
@@ -283,25 +290,10 @@
          (cdr y)
          url))
 
-(define (utf8-string pango-font-description string)
-  (ly:warning (_ "utf8-string encountered in PS backend")))
+(define (utf-8-string pango-font-description string)
+  (ly:warning (_ "utf-8-string encountered in PS backend")))
 
 
-;; TODO: FIX THIS.
-;;
-(define (white-dot x y radius)
-  (string-append
-   " "
-   (ly:numbers->string
-    (list x y radius)) " draw_white_dot"))
-
-(define (white-text scale s)
-  (let ((mystring (string-append
-                  "(" s  ") " (number->string scale)
-                  " /Helvetica-Bold "
-                  " draw_white_text")))
-    mystring
-    ))
 
 (define (zigzag-line centre? zzw zzh thick dx dy)
   (string-append