(stencil->string): Rewrite.

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

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 111542abeaaf2327062e6493c257af6f03b27a81..83172251903c3f20688c9349116519f359a156ab 100644 (file)
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -99,15 +99,23 @@
         cmbx17
         cmbxti12
         cmbxti14
+        cmbxti6
         cmbxti7
         cmbxti8
         cmcsc12
         cmcsc7
+        cmcsc8
+        cmss5
+        cmss6
+        cmss7
+        cmti5
+        cmti6
         cmtt17
-        
-        ;;; FIXME: added
-        cmbx8)))
-  
+        cmtt5
+        cmtt6
+        cmtt7)))
+
+
 (define (define-fonts internal-external-name-mag-pairs)
 
   (define (font-load-command name-mag command)
@@ -117,7 +125,12 @@
       (cond
        ((and (equal? (substring name 0 2) "cm")
             (not (member name lily-traced-cm-fonts)))
-       (string-upcase name))
+       
+       ;; huh, how is this supposed to work?
+       ;;(string-upcase name)
+       
+       (string-append name ".pfb"))
+       
        ((equal? (substring name 0 4) "feta")
        (regexp-substitute/global #f "feta([a-z-]*)([0-9]+)" name 'pre "GNU-LilyPond-feta" 1 "-" 2 'post))
        (else name)))
@@ -288,7 +301,14 @@
    "\n" (ly:number->string height)
    " start-system\n"
    "{\n"
-   "set-ps-scale-to-lily-scale"))
+   "set-ps-scale-to-lily-scale\n"
+
+   ;; URG
+   (if (pair? header-stencils)
+       (let ((s (output-stencils header-stencils)))
+        (set! header-stencils '())
+        (string-append s (stop-system) (start-system width height)))
+       "")))
 
 (define (stem breapth width depth height) 
   (string-append
@@ -347,29 +367,14 @@
 (define (output-scopes paper scopes fields basename)
 
   ;; FIXME: customise/generate these
-  (let ((nmp '((("feta20"  . 0.569055118110236) "feta20" . 1.0)
-              (("cmbx10"  . 0.569055118110236) "cmbx10" . 1.0)
-              (("cmr10"   . 0.569055118110236) "cmr10" . 1.0)
-              (("cmr10"   . 0.638742773474948) "cmr10" . 1.0)
-              (("cmcsc12" . 0.376382788798365) "cmcsc12" . 1.0)
-              (("cmcsc12" . 0.752765577596731) "cmcsc12" . 1.0)
-              (("cmcsc12" . 0.948425196850394) "cmcsc12" . 1.0)
-
-              (("cmr10" . 0.7169645218575) "cmr10" . 1.0)
-              (("cmr10" . 0.638742773474948) "cmr10" . 1.0)
-
-              (("cmcsc10" . 0.451659346558038) "cmcsc10" . 1.0)
-              (("cmcsc10" . 0.638742773474948) "cmcsc10" . 1.0)
-              (("cmbx8"   . 0.564574183197548) "cmbx8" . 1.0)))
-              
-       (props '(((font-family . roman)
+  (let ((props '((;;(linewidth . 120)
+                 (font-family . roman)
                  (word-space . 1)
                  (baseline-skip . 2)
+                 (font-series . medium)
+                 (font-style . roman)
                  (font-shape . upright)
-                 ;;(font-size . -2)
-                 (font-size . 0)
-                 ))))
-
+                 (font-size . 0)))))
   
     (define (output-scope scope)
       (apply
@@ -386,17 +391,14 @@
             ;; define strings, for /make-lilypond-title to pick up
             ((string? val) (ps-string-def "lilypond" sym val))
 
-            ;; output markups ourselves
-            ((markup? val) (string-append
-                            (write-me "expr:"
-                                      ;; siamo bionde :-)
-                                      ;;(expression->string
-                                      (output-stencil
-                                       (ly:stencil-get-expr
-                                        (interpret-markup paper props val))
-                                       '(0 . 0)
-                                       ))
-                            "\n"))
+            ;; generate stencil from markup
+            ((markup? val) (set! header-stencils
+                                 (append header-stencils
+                                    (list
+                                     (ly:stencil-get-expr
+                                      (interpret-markup paper props val)))))
+             
+             "")
             ((number? val) (ps-number-def
                             "lilypond" sym (if (integer? val)
                                                (number->string val)
@@ -406,49 +408,35 @@
        scope)))
 
     (string-append
-     ;; urg
-     " 0 0 moveto\n"
-     (define-fonts nmp)
      (apply string-append (map output-scope scopes)))))
 
-(define (add-offsets a b)
+(define (offset-add a b)
   (cons (+ (car a) (car b))
        (+ (cdr a) (cdr b))))
 
-(define (input? foe)
-  #f)
-
-;; TODO:
-;; de-urg me
-;; implement ly:input stuff
-;; replace C++ variant
-;; stencil->string?
-(define (output-stencil expr o)
-  (let ((s ""))
-    (format (current-output-port) "output-stencil: ~S\n" expr)
-    (while
-     (pair? expr)
-     (let ((head (car expr)))
-       (format (current-output-port) "head: ~S\n" head)
-       (cond ((input? head)
-             (set! s (string-append
-                      s (define-origin (ly:input-file-string head))))
-             (set! expr (cadr expr)))
-            ((eq? head 'no-origin)
-             (set! s (string-append s expression->string head))
-             (set! expr (cadr expr)))
-            ((eq? head 'translate-stencil)
-             (set! o (add-offsets o (cadr expr)))
-             (set! expr (caddr expr)))
-            ((eq? head 'combine-stencil)
-             (set! s (string-append s (output-stencil (cadr expr) o)))
-             (set! expr (caddr expr)))
-            (else
-             (set!
-              s (string-append
-                 s
-                      (placebox (car o) (cdr o)
-                                (expression->string expr))))
-             (set! expr #f)))))
-;;   (set! expr (cadr expr)))
-  s))
+(define header-stencils '())
+
+(define (output-stencils lst)
+  (apply string-append
+        (map (lambda (x) (stencil->string x '(10 . -10))) lst)))
+
+;; hmm, looks like recursing call is always last statement, does guile
+;; think so too?
+(define (stencil->string expr o)
+  (if (pair? expr)
+      (let ((head (car expr)))
+       (cond
+        ((ly:input-location? head)
+         (string-append (apply define-origin (ly:input-location head))
+                        (stencil->string (cadr expr) o)))
+        ((eq? head 'no-origin)
+         (string-append (expression->string head)
+                        (stencil->string (cadr expr) o)))
+        ((eq? head 'translate-stencil)
+         (stencil->string (caddr expr) (offset-add o (cadr expr))))
+        ((eq? head 'combine-stencil)
+         (string-append (stencil->string (cadr expr) o)
+                        (stencil->string (caddr expr) o)))
+        (else
+         (placebox (car o) (cdr o) (expression->string expr)))))
+      ""))