* scm/output-ps.scm (utf8-string): add utf8-string for completeness.

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

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 6899b747807313b59b3cd07de24952db04629977..19193d4fc78df82f1d4c2beab552179070e5f5cb 100644 (file)
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -156,30 +156,47 @@
 (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"))
+   " 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 font postscript-font-name x-y-named-glyphs)
+
+(define (utf8-string pango-font-description string)
+  (ly:warn "utf8-string encountered in PS backend"))
+
+(define (glyph-string
+        postscript-font-name
+        size
+        x-y-named-glyphs)
+  (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
-   (cons
-    (format #f " /~a findfont setfont " postscript-font-name)
-    (map (lambda  (item)
-          (format #f " ~a ~a rmoveto /~a glyphshow "
-                  (car item)
-                  (cadr item)
-                  (caddr item)))
-        x-y-named-glyphs))))
+   (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 " g)
+               (format #f " ~a ~a rmoveto /~a glyphshow "
+                       x y g))))
+       x-y-named-glyphs))
+  ))
 
 (define (grob-cause grob)
   "")
@@ -225,42 +242,13 @@
    (ly:numbers->string
     (list x y width height blotdiam)) " draw_round_box"))
 
-(define (old-text font s)
-  ;; ugh, we should find a better way to
-  ;; extract the hsbw for /space from the font.
-  (let* ((space-length (cdar (ly:text-dimension font " "))) 
-        (commands '())
-        (add-command (lambda (x) (set! commands (cons x commands)))))
-
-    (string-fold
-     (lambda (chr word)
-       "Translate space as into moveto, group the rest in words."
-       (if (and (< 0 (string-length word))
-               (equal? #\space  chr))
-          (add-command 
-           (string-append "(" (ps-encoding word) ") show\n")))
-
-       (if (equal? #\space chr)
-          (add-command  (string-append (number->string space-length)
-                                       " 0.0 rmoveto ")))
-       
-       (if (equal? #\space chr)
-          ""
-          (string-append word (make-string 1 chr))))
-     ""
-     (string-append s " "))
-
-    (string-append
-     (ps-font-command font) " setfont "
-     (string-join (reverse commands)))))
-
-(define (new-text font s)
+(define (text font s)
+;  (ly:warn "TEXT backend-command encountered in Pango backend\nargs: ~a ~a" font str)
+  
   (let* ((space-length (cdar (ly:text-dimension font " ")))
         (space-move (string-append (number->string space-length)
                                    " 0.0 rmoveto "))
-        (input-enc (assoc-get 'input-name
-                              (ly:font-encoding-alist font)
-                              'latin1))
+        (input-enc "latin1")
         (out-vec (decode-byte-string input-enc s)))
 
     (string-append
@@ -275,16 +263,18 @@
              (string-append "/" (symbol->string sym) " glyphshow")))
        out-vec))))))
 
-;;(define text old-text)
-(define text new-text)
-
 ;; FIXME: BARF helvetica?
 (define (white-text scale s)
   (let ((mystring (string-append
                   "(" s  ") " (number->string scale)
                   " /Helvetica-Bold "
                   " draw_white_text")))
-    mystring))
+    mystring
+
+
+    ;; FIXME: broken with user install of GS 8.x
+    ""
+    ))
 
 (define (unknown) 
   "\n unknown\n")