X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-ps.scm;h=69f277203934985a01979476b56df1803c5a1bae;hb=b25b4262c8124b4d4279527ce00f1c7dd705a9c7;hp=45ef4e9ff3c147728e021188b52dce479c678d12;hpb=c054eb280fd9953596eb164f67b0f9d5555c5a32;p=lilypond.git

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 45ef4e9ff3..69f2772039 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -117,28 +117,30 @@
                       size
                       cid?
                       w-x-y-named-glyphs)
-
   (define (glyph-spec w h x y g) ; h not used
     (let ((prefix (if (string? g) "/" "")))
-      (ly:format "~4f ~4f ~4f ~a~a"
-                 w x y
-                 prefix g)))
-
-  (ly:format
-   (if cid?
-       "/~a /CIDFont findresource ~a output-scale div scalefont setfont
-~a
-~a print_glyphs"
-
-       "/~a ~a output-scale div selectfont
-~a
-~a print_glyphs")
-   postscript-font-name
-   size
-   (string-join (map (lambda (x) (apply glyph-spec x))
-                     (reverse w-x-y-named-glyphs)) "\n")
-   (length w-x-y-named-glyphs)))
-
+      (ly:format "~4f ~4f ~4f ~a~a" w x y prefix g)))
+  (define (emglyph-spec w h x y g) ; h not used
+    (if (and (= x 0) (= y 0))
+        (ly:format "currentpoint ~a moveto ~4f 0 rmoveto" g w)
+        (ly:format "currentpoint ~4f ~4f rmoveto ~a moveto ~4f 0 rmoveto" x y g w)))
+  (if cid?
+      (ly:format
+       "/~a /CIDFont findresource ~a output-scale div scalefont setfont\n~a\n~a print_glyphs"
+       postscript-font-name size
+       (string-join (map (lambda (x) (apply glyph-spec x))
+                         (reverse w-x-y-named-glyphs)) "\n")
+       (length w-x-y-named-glyphs))
+      (if (and (ly:bigpdfs) (string-startswith postscript-font-name "Emmentaler"))
+          (ly:format "/~a-O ~a output-scale div selectfont\n~a"
+                     postscript-font-name size
+                     (string-join (map (lambda (x) (apply emglyph-spec x))
+                                       w-x-y-named-glyphs) "\n"))
+          (ly:format "/~a ~a output-scale div selectfont\n~a\n~a print_glyphs"
+                     postscript-font-name size
+                     (string-join (map (lambda (x) (apply glyph-spec x))
+                                       (reverse w-x-y-named-glyphs)) "\n")
+                     (length w-x-y-named-glyphs)))))
 
 (define (grob-cause offset grob)
   (if (ly:get-option 'point-and-click)
@@ -155,10 +157,6 @@
                                 (ly:in-event-class? cause t))
                               point-and-click))))
             (let* ((location (ly:input-file-line-char-column music-origin))
-                   (raw-file (car location))
-                   (file (if (is-absolute? raw-file)
-                             raw-file
-                             (string-append (ly-getcwd) "/" raw-file)))
                    (x-ext (ly:grob-extent grob grob X))
                    (y-ext (ly:grob-extent grob grob Y)))
 
@@ -173,7 +171,7 @@
                              ;; Backslashes are not valid
                              ;; file URI path separators.
                              (ly:string-percent-encode
-                              (ly:string-substitute "\\" "/" file))
+                              (ly:string-substitute "\\" "/" (car location)))
 
                              (cadr location)
                              (caddr location)
@@ -183,9 +181,19 @@
       ""))
 
 (define (named-glyph font glyph)
-  (ly:format "~a /~a glyphshow " ;;Why is there a space at the end?
-             (ps-font-command font)
-             glyph))
+  (if (and (ly:bigpdfs) (string-startswith (ly:font-file-name font) "emmentaler"))
+      (if (string-endswith (ly:font-file-name font)"-brace")
+          (if (or (string-startswith glyph "brace1") (string-startswith glyph "brace2"))
+              (ly:format "~a ~a" (string-append (ps-font-command font) "-N" ) glyph)
+              (if (or (string-startswith glyph "brace3") (string-startswith glyph "brace4"))
+                  (ly:format "~a ~a" (string-append (ps-font-command font) "-S" ) glyph)
+                  (ly:format "~a ~a" (string-append (ps-font-command font) "-O" ) glyph)))
+          (if (string-startswith glyph "noteheads")
+              (ly:format "~a ~a" (string-append (ps-font-command font) "-N" ) glyph)
+              (if (or (string-startswith glyph "scripts") (string-startswith glyph "clefs"))
+                  (ly:format "~a ~a" (string-append (ps-font-command font) "-S" ) glyph)
+                  (ly:format "~a ~a" (string-append (ps-font-command font) "-O" ) glyph))))
+      (ly:format "~a /~a glyphshow" (ps-font-command font) glyph)))
 
 (define (no-origin)
   "")
@@ -283,15 +291,20 @@
                                     (ly:warning (_ "unknown line-join-style: ~S")
                                                 (symbol->string join))
                                     1)))))
-    (ly:format
-     "gsave currentpoint translate
+     (ly:format
+      "gsave currentpoint translate
 ~a setlinecap ~a setlinejoin ~a setlinewidth
-~l gsave stroke grestore ~a grestore"
-     cap-numeric
-     join-numeric
-     thickness
-     (convert-path-exps exps)
-     (if fill? "fill" ""))))
+~l ~a grestore"
+      cap-numeric
+      join-numeric
+      thickness
+      (convert-path-exps exps)
+      ;; print outline contour only if there is no fill or if
+      ;; contour is explicitly requested with a thickness > 0
+      (cond ((not fill?) "stroke")
+            ((positive? thickness) "gsave stroke grestore fill")
+            (else "fill")))))
+
 
 (define (setscale x y)
   (ly:format "gsave ~4l scale\n"