X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-ps.scm;h=e0bd54d9240c8a682109cbda33c8acc3815f2cc3;hb=5ef42aae6aa85135614289aeaf36adaf3ab2c998;hp=cc021b84234809fdaaae12fb4e0666b5a0bd9e94;hpb=0fcd8c283c45644a92d2308f1cd0d82a1e63380b;p=lilypond.git

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index cc021b8423..e0bd54d924 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -21,9 +21,6 @@
 	    blank
 	    circle
 	    dot
-	    white-dot
-	    beam
-	    bracket
 	    dashed-slur
 	    char
 	    setcolor
@@ -31,17 +28,13 @@
 	    named-glyph
 	    dashed-line
 	    zigzag-line
-	    ez-ball
 	    comment
 	    repeat-slash
 	    placebox
 	    bezier-sandwich
-	    horizontal-line
 	    embedded-ps
-	    filledbox
 	    round-filled-box
 	    text
-	    white-text
 	    polygon
 	    draw-line
 	    no-origin))
@@ -54,14 +47,6 @@
 	     (scm framework-ps)
 	     (lily))
 
-
-;;(map export
-;;   (append (ly:all-stencil-expressions) (ly:all-output-backend-commands)))
-
-;; huh?
-;;(write (ly:all-output-backend-commands))
-;;(write (ly:all-stencil-expressions))
-
 ;;; helper functions, not part of output interface
 (define (escape-parentheses s)
   (regexp-substitute/global #f "(^|[^\\])([\\(\\)])" s 'pre 1 "\\" 2 'post))
@@ -87,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 
@@ -100,12 +80,6 @@
    (ly:number->string thick)
    " draw_bezier_sandwich"))
 
-(define (bracket arch_angle arch_width arch_height height arch_thick thick)
-  (string-append
-   (ly:numbers->string
-    (list arch_angle arch_width arch_height height arch_thick thick))
-   " draw_bracket"))
-
 (define (char font i)
   (string-append 
    (ps-font-command font) " setfont " 
@@ -158,42 +132,53 @@
 (define (embedded-ps string)
   string)
 
-;; FIXME. 
-(define (ez-ball ch letter-col ball-col)
-  (string-append
-   " (" ch ") "
-   (ly:numbers->string (list letter-col ball-col))
-   ;; FIXME: barf
-   " /Helvetica-Bold "
-   " draw_ez_ball"))
-
-;; 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
+	 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 findfont ~a scalefont setfont\n~a grestore" postscript-font-name size
-  (apply
-   string-append
-   (map (lambda  (item)
-	  (let
-	      ((x (car item))
-		(y (cadr item))
-		(g (caddr item)))
-
-	    (if (and (= 0.0 x)
-		     (= 0.0 y))
-		(format #f " /~a glyphshow\n" g)
-		(format #f " ~a ~a rmoveto ~a~a glyphshow\n"
-			x y
-			(if  (string? g) "/" "")
-			g))))
-	x-y-named-glyphs))))
+  /~a ~a ~a scalefont setfont\n~a grestore"
+	  postscript-font-name
+	  (if cid?
+	      " /CIDFont findresource "
+	      " findfont")
+	
+	  size
+	  (apply
+	   string-append
+	   (map (lambda  (item)
+		  (let*
+		      ((x (car item))
+		       (y (cadr item))
+		       (g (caddr item))
+		       (prefix (if  (string? g) "/" "")))
+
+		    (if (and (= 0.0 x)
+			     (= 0.0 y))
+			(format #f " ~a~a glyphshow\n" prefix g)
+			(format #f " ~a ~a rmoveto ~a~a glyphshow\n"
+				x y
+				prefix
+				g))))
+		x-y-named-glyphs))))
 
 (define (grob-cause offset grob)
   (let* ((cause (ly:grob-property grob 'cause))
@@ -201,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
@@ -211,20 +196,20 @@
 
 	  (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))
 	      "")))))
 
-;; WTF is this in every backend?
-(define (horizontal-line x1 x2 th)
-  (draw-line th x1 0 x2 0))
-
 (define (lily-def key val)
   (let ((prefix "lilypondlayout"))
     (if (string=?
@@ -305,22 +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")))
+
 
-(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