]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/framework-ps.scm
*** empty log message ***
[lilypond.git] / scm / framework-ps.scm
index 0c96ee1cdd958df7859b58d02002e0c2c58adb50..67c35ebfc0871a09d37e8d197d362287115bde31 100644 (file)
             (srfi srfi-13)
             (lily))
 
+(define (stderr string . rest)
+  (apply format (cons (current-error-port) (cons string rest)))
+  (force-output (current-error-port)))
+
+;;(define pdebug stderr)
+(define (pdebug . rest) #f)
+
 (define mm-to-bigpoint
   (/ 72 25.4))
 
         (pfas (map
                (lambda (x)
                
-               (let*
-                   ((aname (string-append x ".pfa"))
-                    (apath (ly:kpathsea-expand-path aname))
-
-                    (bpath (if (not apath)
-                               (ly:kpathsea-expand-path (string-append x ".pfb"))
-                               #f)))
-                    
-                           
-                 (cond
-                  (apath (ly:gulp-file apath))
-                  (bpath (ly:pfb->pfa bpath))
-                  (else
-                   (ly:warn "Can't find PFA font ~S" x)
-                   ""))))
+                 (let* ((aname (string-append x ".pfa"))
+                        (apath (ly:kpathsea-expand-path aname))
+                        
+                        (bpath (if (not apath)
+                                   (ly:kpathsea-expand-path
+                                    (string-append x ".pfb"))
+                                   #f)))
+                   (cond
+                    (apath (ly:gulp-file apath))
+                    (bpath (ly:pfb->pfa bpath))
+                    (else
+                     (ly:warn "Can't find PFA font ~S" x)
+                     ""))))
                (filter string? font-names))))
   
     (string-join pfas "\n")))
        plain " " coding-vector " /" command " reencode-font\n"
        "/" command "{ /" command " findfont 1 scalefont } bind def\n")))
 
-  (define (guess-ps-fontname basename)
-
-    "We do not have the FontName, try to guess is from basename."
-    (cond
-     (#t basename)
-     ((tex-font? basename)
-      ;; FIXME: we need proper Fontmap for the bluesky CM*, EC* fonts.
-      ;; Only the fonts that we trace in mf/ are in our own FontMap.
-      (string-append basename ".pfb"))
-     (else (string-append basename ".pfa"))))
-
+  (define (standard-tex-font? x)
+    (or (equal? (substring x 0 2) "ms")
+       (equal? (substring x 0 2) "cm")))
   (define (font-load-command font)
     (let* ((specced-font-name (ly:font-name font))
           (fontname (if specced-font-name
                         specced-font-name
-                        (guess-ps-fontname (ly:font-filename font))))
+                        (ly:font-filename font)))
        
           (coding-alist (ly:font-encoding-alist font))
           (input-encoding (assoc-get 'input-name coding-alist))
           (ops (ly:output-def-lookup bookpaper 'outputscale))
           (scaling (* ops magnification designsize)))
 
+      ;; Bluesky pfbs have UPCASE names (sigh.)
+      ;;
+      (if (standard-tex-font? fontname)
+         (set! fontname (string-upcase fontname)))
+      
+      ;; debugging: [output]encoding is broken
+      ;; found so far: coding-alist is empty!
+      (pdebug "font: ~S\n" font)
+      (pdebug "fontname: ~S\n" fontname)
+      (pdebug "input-encoding:~S\n" input-encoding)
+      (pdebug "font-encoding:~S\n" font-encoding)
+
+      (pdebug "coding-alist:~S\n" coding-alist)
+      
       (string-append
        (define-font plain fontname scaling)
-       (if (or (equal? input-encoding font-encoding)
-              ;; guh
-              (equal? font-encoding "fetaBraces")
-              (equal? font-encoding "fetaNumber")
-              (equal? font-encoding "fetaMusic")
-              (equal? font-encoding "parmesanMusic"))
-              ""
+       (if (equal? input-encoding font-encoding)
+          ""
           (reencode-font plain input-encoding command)))))
 
   (define (font-load-encoding encoding)
         (encodings (uniq-list (sort-list (filter string? encoding-list)
                                          string<?))))
 
+    (pdebug "encodings:~S\n" encodings)
     (string-append
      (apply string-append (map font-load-encoding encodings))
      (apply string-append
      (value->string (ly:output-def-lookup paper ly-key)) " def \n"))
 
   (string-append
-   "/lily-output-units " (number->string mm-to-bigpoint) "  def  %% milimeter \n"
+   "/lily-output-units " (number->string mm-to-bigpoint) " def %% milimeter \n"
    (output-entry "staff-line-thickness" 'linethickness)
    (output-entry "line-width" 'linewidth)
    (output-entry "paper-size" 'papersize)
 (define (eps-header bookpaper bbox)
   (string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
                 "%%Creator: creator time-stamp\n"
-                "%%BoundingBox: " (string-join (map number->string  bbox) " ") "\n"
+                "%%BoundingBox: "
+                (string-join (map number->string bbox) " ") "\n"
                 "%%EndComments\n"))
 
 (define (page-header bookpaper page-count)
                 "%%Creator: creator time-stamp\n"
                 "%%Pages: " (number->string page-count) "\n"
                 "%%PageOrder: Ascend\n"
-                "%%DocumentPaperSizes: " (ly:output-def-lookup bookpaper 'papersize) "\n"))
+                "%%DocumentPaperSizes: "
+                (ly:output-def-lookup bookpaper 'papersize) "\n"))
 
 (define (preamble bookpaper)
   (list
 (define-public (output-framework outputter book scopes fields basename)
   (let* ((bookpaper (ly:paper-book-book-paper book))
         (pages (ly:paper-book-pages book))
-        (page-number 0)
+        (page-number (1- (ly:output-def-lookup bookpaper 'firstpagenumber)))
         (page-count (length pages)))
   (for-each
    (lambda (x)
 
 (define-public (output-preview-framework outputter book scopes fields basename)
   (let* ((bookpaper (ly:paper-book-book-paper book))
-        (systems (ly:paper-book-lines book))
+        (systems (ly:paper-book-systems book))
         (scale  (ly:output-def-lookup bookpaper 'outputscale ))
         (titles (take-while ly:paper-system-title? systems))
-        (non-title (find (lambda (x) (not (ly:paper-system-title? x))) systems))
+        (non-title (find (lambda (x)
+                           (not (ly:paper-system-title? x))) systems))
         (dump-me
          (stack-stencils Y DOWN 0.0 
                          (map ly:paper-system-stencil
                               (append titles (list non-title)))))
         (xext (ly:stencil-extent dump-me X))
-        (yext (ly:stencil-extent dump-me Y))
-        )
+        (yext (ly:stencil-extent dump-me Y)))
     
   (for-each
    (lambda (x)
                            (string-append "0 0 start-system { "
                                           "set-ps-scale-to-lily-scale "
                                           "\n"))
+
   (ly:outputter-dump-stencil outputter dump-me)
   (ly:outputter-dump-string outputter "} stop-system\n%%Trailer\n%%EOF\n")))
 
       ((defs (ly:paper-book-book-paper book))
        (size (ly:output-def-lookup defs 'papersize)))
 
-    (postscript->pdf (if (string? size) size "a4")
-                    name)))
-
+    (if (equal? name "-")
+       (ly:warn "Can't convert <stdout> to PDF")
+       (postscript->pdf (if (string? size) size "a4")
+                        name))))
+  
 (define-public (convert-to-png book name)
   (let*
       ((defs (ly:paper-book-book-paper book))
 
 (define-public (convert-to-ps book name)
   #t)
-