]> git.donarmstrong.com Git - lilypond.git/commitdiff
(output-classic-framework): new function:
authorHan-Wen Nienhuys <hanwen@xs4all.nl>
Thu, 6 Jan 2005 22:40:59 +0000 (22:40 +0000)
committerHan-Wen Nienhuys <hanwen@xs4all.nl>
Thu, 6 Jan 2005 22:40:59 +0000 (22:40 +0000)
dump systems as separate .eps files (without fonts) and write a
single collecting .tex file.

ChangeLog
lily/include/duration.hh
scm/framework-ps.scm

index 9f1a54e3c8fd1ce44bf1ddfc9b16a9e9ab476307..08ef3b6f8f7e7767bb21d4e2750b8f59d28aef11 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2005-01-06  Han-Wen Nienhuys  <hanwen@xs4all.nl>
+
+       * scm/framework-ps.scm (output-classic-framework): new function:
+       dump systems as separate .eps files (without fonts) and write a
+       single collecting .tex file.
+
 2005-01-05  Mats Bengtsson  <mabe@drongo.s3.kth.se>
 
        * Documentation/user/notation.itely (Setting simple songs):
@@ -30,8 +36,8 @@
 
 2005-01-03  Han-Wen Nienhuys  <hanwen@xs4all.nl>
 
-       * lily/pango-font.cc (text_stencil): dump string as (utf-8-string
-       FONTDESC UTF8) for use in -f gnome, -f svg.
+       * lily/pango-font.cc (text_stencil): dump string as
+       (utf-8-string FONTDESC UTF8) for use in -f gnome, -f svg.
 
 2005-01-03  Jan Nieuwenhuizen  <janneke@gnu.org>
 
index 793042cb23cf884c6e0e60ae7deb31876a8770ac..3b4bd958ca406060ca75b0506b6b587c577b3729 100644 (file)
@@ -25,7 +25,7 @@ public:
   Duration compressed (Rational) const;
   Rational get_length () const ;
   Rational factor () const { return factor_; }
-  int duration_log ()const;
+  int duration_log () const;
   int dot_count () const;
 
   static int compare (Duration const&, Duration const&);
@@ -34,7 +34,7 @@ public:
   DECLARE_SIMPLE_SMOBS (Duration,);
 
 private:
-    /// Logarithm of the base duration.
+  /// Logarithm of the base duration.
   int durlog_;
   int dots_;
 
index 5daf3e8343b4a022f12c2edb698a09da9b849145..a0330f7557d13b0cbc58ee9113492765fc864383 100644 (file)
@@ -6,6 +6,8 @@
 
 (define-module (scm framework-ps))
 
+;;; this is still too big a mess.
+
 (use-modules (ice-9 regex)
             (ice-9 string-fun)
             (ice-9 format)
 ")))
 
 
-(define (load-fonts paper)
-  (let* ((fonts (ly:paper-fonts paper))
-        (all-font-names
-         (map
-          (lambda (font)
-            (if (string? (ly:font-file-name font))
-                (list (ly:font-file-name font))
-                (ly:font-sub-fonts font)))
-
-          fonts))
-        (font-names
-         (uniq-list
-          (sort (apply append all-font-names) string<?)))
-        (pfas (map
-               (lambda (x)
-                 (let* ((bare-file-name (ly:find-file x))
-                        (cffname (string-append x ".cff"))
-                        (aname (string-append x ".pfa"))
-                        (bname (string-append x ".pfb"))
-                        (cff-file-name (ly:find-file cffname))
-                        (a-file-name (ly:kpathsea-find-file aname))
-                        (b-file-name (ly:kpathsea-find-file bname)))
-                   (cond
-                    (bare-file-name (if (string-match "\\.pfb" bare-file-name)
-                                        (ly:pfb->pfa bare-file-name)
-                                        (ly:gulp-file bare-file-name)))
-                    (cff-file-name (ps-embed-cff (ly:gulp-file cff-file-name) x 0))
-                    (a-file-name (ly:gulp-file a-file-name))
-                    (b-file-name (ly:pfb->pfa b-file-name))
-                    (else
-                     (ly:warn "cannot find CFF/PFA/PFB font ~S" x)
-                     ""))))
-               (filter string? font-names))))
-    
-    (string-join pfas "\n")))
 
 (define (define-fonts paper)
   
 
       
       ;; Bluesky pfbs have UPCASE names (sigh.)
-      ;;
+      ;; FIXME - don't support Bluesky? 
       (if (standard-tex-font? fontname)
          (set! fontname (string-upcase fontname)))
       
   (ly:outputter-dump-stencil outputter page)
   (ly:outputter-dump-string outputter "} stop-system \nshowpage\n"))
 
-(define (eps-header paper bbox)
-  (string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
+(define (supplies-or-needs paper load-fonts?)
+  (let* ((fonts (ly:paper-fonts paper)))
+    (apply string-append
+          (map (lambda (f)
+                 (format
+                  (if load-fonts?
+                   "%%DocumentSuppliedResources: font ~a\n"
+                   "%%DocumentNeededResources: font ~a\n")
+                  (ly:font-name f)))
+               fonts))))
+
+(define (eps-header paper bbox load-fonts?)
+    (string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
                 "%%Creator: creator time-stamp\n"
                 "%%BoundingBox: "
                 (string-join (map ly:number->string bbox) " ") "\n"
                 (if (eq? (ly:output-def-lookup paper 'landscape) #t)
                     "Landscape\n"
                     "Portrait\n")
+                (supplies-or-needs paper load-fonts?)
                 "%%EndComments\n"))
 
-(define (page-header paper page-count)
+(define (page-header paper page-count load-fonts?)
   (string-append "%!PS-Adobe-3.0\n"
                 "%%Creator: creator time-stamp\n"
                 "%%Pages: " (number->string page-count) "\n"
                     "Landscape\n"
                     "Portrait\n")
                 "%%DocumentPaperSizes: "
-                (ly:output-def-lookup paper 'papersizename) "\n"))
+                (ly:output-def-lookup paper 'papersizename) "\n"
+                (supplies-or-needs paper load-fonts?)
+                "%%EndComments\n"))
 
-(define (preamble paper)
+(define (preamble paper load-fonts?)
+  (define (load-fonts paper)
+    (let* ((fonts (ly:paper-fonts paper))
+          (all-font-names
+           (map
+            (lambda (font)
+              (if (string? (ly:font-file-name font))
+                  (list (ly:font-file-name font))
+                  (ly:font-sub-fonts font)))
+
+            fonts))
+          (font-names
+           (uniq-list
+            (sort (apply append all-font-names) string<?)))
+          (pfas (map
+                 (lambda (x)
+                   (let* ((bare-file-name (ly:find-file x))
+                          (cffname (string-append x ".cff"))
+                          (aname (string-append x ".pfa"))
+                          (bname (string-append x ".pfb"))
+                          (cff-file-name (ly:find-file cffname))
+                          (a-file-name (ly:kpathsea-find-file aname))
+                          (b-file-name (ly:kpathsea-find-file bname)))
+                     (cond
+                      (bare-file-name (if (string-match "\\.pfb" bare-file-name)
+                                          (ly:pfb->pfa bare-file-name)
+                                          (ly:gulp-file bare-file-name)))
+                      (cff-file-name (ps-embed-cff (ly:gulp-file cff-file-name) x 0))
+                      (a-file-name (ly:gulp-file a-file-name))
+                      (b-file-name (ly:pfb->pfa b-file-name))
+                      (else
+                       (ly:warn "cannot find CFF/PFA/PFB font ~S" x)
+                       ""))))
+                 (filter string? font-names))))
+      
+      (string-join pfas "\n")))
+          
+  
+  
   (list
    (output-variables paper)
    (ly:gulp-file "music-drawing-routines.ps")
    (ly:gulp-file "lilyponddefs.ps")
-   (load-fonts paper)
+   (if load-fonts?
+       (load-fonts paper)
+       "")
+   
    (define-fonts paper)))
 
-
-  
-
 (define-public (output-framework basename book scopes fields )
   (let* ((filename (format "~a.ps" basename))
         (outputter  (ly:make-paper-outputter filename
      (lambda (x)
        (ly:outputter-dump-string outputter x))
      (cons
-      (page-header paper page-count)
-      (preamble paper)))
+      (page-header paper page-count #t)
+      (preamble paper #t)))
     
     (for-each
      (lambda (page)
                   (lambda (x)
                     (inexact->exact
                      (round (* x scale mm-to-bigpoint))))
-                  bbox))
-      (preamble paper)))
+                  bbox)
+                 #t)
+      (preamble paper #t)))
 
 
     (ly:outputter-dump-string outputter
 
 (define-public (output-classic-framework
                basename book scopes fields)
-  (let* ((paper (ly:paper-book-paper book))
-        (lines (ly:paper-book-systems book))
+  (define paper (ly:paper-book-paper book))
+  (define (dump-line outputter line)
+    (let*
+       ((dump-me (ly:paper-system-stencil line))
+        (xext (ly:stencil-extent dump-me X))
+        (yext (ly:stencil-extent dump-me Y))
+        (scale  (ly:output-def-lookup paper 'outputscale))
+        (bbox
+         (map
+          (lambda (x)
+            (if (or (nan? x) (inf? x))
+                0.0 x))
+          (list (car xext) (car yext)
+                (cdr xext) (cdr yext))))
+        (header (eps-header paper
+                            (map
+                             (lambda (x)
+                               (inexact->exact
+                                (round (* x scale mm-to-bigpoint))))
+                             bbox) #f)))
+
+      (for-each
+       (lambda (str) (ly:outputter-dump-string outputter str))
+       (cons
+       header
+       (preamble paper #f)))
+      
+      (ly:outputter-dump-string outputter
+                               (string-append "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")
+      (ly:outputter-close outputter)))
+  
+  (define (dump-lines lines count)
+    (if (pair? lines)
+       (let*
+           ((outputter  (ly:make-paper-outputter (format "~a-~a.eps" basename count)
+                                                 (ly:output-backend)))
+            (line (car lines))
+            (rest (cdr lines)))
+         (dump-line outputter line)
+         (dump-lines rest (1+ count))
+         )))
+    
+  (let* ((lines (ly:paper-book-systems book))
+        (tex-port (open-output-file (format "~a.tex" basename)))
         (last-line (car (last-pair lines))))
-    (for-each
-     (lambda (x)
-       (ly:outputter-dump-string outputter x))
-     (list
-      ;;FIXME
-      (header paper (length lines) #f)
-      "\\def\\lilypondclassic{1}%\n"
-      (output-scopes scopes fields basename)
-      (define-fonts paper)
-      (header-end)))
 
-    (for-each
-     (lambda (line) (dump-line outputter line (eq? line last-line))) lines)
-    (ly:outputter-dump-string outputter "\\lilypondend\n")
-    (ly:outputter-close outputter)
-    (postprocess-output book framework-ps-module filename (ly:output-formats)) 
-    ))
+    (dump-lines lines 1)
+    (for-each (lambda (c)
+               (display (format "\\includegraphics{~a-~a.eps}%\n"
+                                basename (1+ c)) tex-port))
+             (iota (length lines))
+             )))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;