X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-ps.scm;h=10934b84e86812e3d2e4c97c568386c350578686;hb=5d576b1299d374ae478cb38075cc05d5cb691046;hp=3998d0f0b7c4b2aa385c72b90385afd043425f59;hpb=51d6ad94a784e44bb33b6f462bf27cbc07d6606c;p=lilypond.git

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 3998d0f0b7..10934b84e8 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;;
-;;;; (c) 2004--2006 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; (c) 2004--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
 
 (define-module (scm framework-ps))
 
@@ -42,8 +42,7 @@
   (define font-list (ly:paper-fonts paper))
   (define (define-font command fontname scaling)
     (string-append
-     "/" command " { /" fontname " findfont "
-     (ly:number->string scaling) " output-scale div scalefont } bind def\n"))
+      "/" command " { /" fontname " " (ly:number->string scaling) " output-scale div selectfont } bind def\n"))
 
   (define (standard-tex-font? x)
     (or (equal? (substring x 0 2) "ms")
@@ -116,7 +115,8 @@
 	"page-width output-scale lily-output-units mul mul 0 translate 90 rotate\n"
 	"")
     "%%EndPageSetup\n"
-
+    
+    "true setstrokeadjust\n"
     "gsave 0 paper-height translate "
     "set-ps-scale-to-lily-scale "
     "\n"))
@@ -156,19 +156,22 @@
 		 "%%EndComments\n"))
 
 (define (ps-document-media paper) 
+ (let* ((w (/ (*
+	       (ly:output-def-lookup paper 'output-scale)
+	       (ly:output-def-lookup paper 'paper-width)) (ly:bp 1)))
+	(h (/ (*
+	       (ly:output-def-lookup paper 'paper-height)
+	       (ly:output-def-lookup paper 'output-scale))
+	    (ly:bp 1)))
+	(landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
   (format "%%DocumentMedia: ~a ~$ ~$ ~a ~a ~a\n"
-	  (ly:output-def-lookup paper 'papersizename)
-	  (/ (*
-	      (ly:output-def-lookup paper 'output-scale)
-	      (ly:output-def-lookup paper 'paper-width)) (ly:bp 1))
-	  (/ (*
-	      (ly:output-def-lookup paper 'paper-height)
-	      (ly:output-def-lookup paper 'output-scale))
-	     (ly:bp 1))
-	  80  ;; weight
-	  "()" ;; color
-	  "()"  ;; type
-	  ))
+   (ly:output-def-lookup paper 'papersizename)
+   (if landscape? h w)
+   (if landscape? w h)
+   80  ;; weight
+   "()" ;; color
+   "()"  ;; type
+  )))
 
 
 (define (file-header paper page-count load-fonts?)
@@ -188,13 +191,19 @@
 		 "%%EndComments\n"))
 
 (define (procset file-name)
-  (string-append
-   (format
+  (format
     "%%BeginResource: procset (~a) 1 0
 ~a
 %%EndResource
 "
-    file-name (cached-file-contents file-name))))
+    file-name (cached-file-contents file-name)))
+
+(define (embed-document file-name)
+  (format "%%BeginDocument: ~a
+~a
+%%EndDocument
+" 
+    file-name (cached-file-contents file-name)))
 
 (define (setup-variables paper)
   (string-append
@@ -256,15 +265,20 @@
 
       (cons
        name
-       (cond
- 	((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name)
- 	 (ps-load-file (ly:find-file
- 			(format "~a.otf"  file-name))))
-	((string? bare-file-name)
-	 (ps-load-file file-name))
-	(else
-	 (ly:warning (_ "can't embed ~S=~S") name file-name)
-	  "")))))
+       
+       (if (mac-font? bare-file-name)
+	   (handle-mac-font name bare-file-name)
+	   (cond
+	    ((string-match "^([eE]mmentaler|[Aa]ybabtu)" file-name)
+	     (ps-load-file (ly:find-file
+			    (format "~a.otf"  file-name))))
+	    ((string? bare-file-name)
+	     (ps-load-file file-name))
+	    (else
+	     (ly:warning (_ "can't embed ~S=~S") name file-name)
+	     "")))
+
+	  )))
 
   (define (dir-join a b)
     (if (equal? a "")
@@ -323,7 +337,7 @@
 	
       (cond
        ((and file-name (string-match "\\.pfa" downcase-file-name))
-	(cached-file-contents file-name))
+	(embed-document file-name))
        ((and file-name (string-match "\\.pfb" downcase-file-name))
 	(ly:pfb->pfa file-name))
        ((and file-name (string-match "\\.ttf" downcase-file-name))
@@ -333,7 +347,15 @@
        (else
 	(ly:warning (_ "don't know how to embed ~S=~S") name file-name)
 	""))))
-      
+
+    (define (mac-font? bare-file-name)
+      (and
+       (eq? PLATFORM 'darwin)
+       bare-file-name
+       (or
+	(string-match "\\.dfont" bare-file-name)
+	(= (stat:size (stat bare-file-name)) 0))))
+
   (define (load-font font-name-filename)
     (let* ((font (car font-name-filename))
 	   (name (cadr font-name-filename))
@@ -344,14 +366,7 @@
        name
        (cond
 
-	((and
-	  (eq? PLATFORM 'darwin)
-	  bare-file-name (string-match "\\.dfont" bare-file-name))
-	 (handle-mac-font name bare-file-name))
-	
-	((and
-	  (eq? PLATFORM 'darwin)
-	  bare-file-name (= (stat:size (stat bare-file-name)) 0))
+	((mac-font? bare-file-name)
 	 (handle-mac-font name bare-file-name))
 
 	((and font (cff-font? font))
@@ -394,7 +409,7 @@
 		   (lambda (x y) (string<? (cadr x) (cadr y))))))
 
 
-	   (font-loader (if (ly:get-option 'gs-font-load)
+	   (font-loader (if (ly:get-option 'gs-load-fonts)
 			    load-font-via-GS
 			    load-font))
 			 
@@ -416,6 +431,9 @@
   (display (procset "music-drawing-routines.ps") port)
   (display (procset "lilyponddefs.ps") port)
 
+  (if (not (ly:get-option 'point-and-click))
+      (display "/mark_URI { pop pop pop pop pop } bind def\n" port)) 
+
   (display "%%EndProlog\n" port)
   
   (display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port))
@@ -429,6 +447,7 @@
 		     (open-file filename "wb")
 		     "ps"))
 	 (paper (ly:paper-book-paper book))
+	 (systems (ly:paper-book-systems book))
 	 (page-stencils (map page-stencil (ly:paper-book-pages book)))
 	 
 	 (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
@@ -436,11 +455,16 @@
 	 (page-count (length page-stencils))
 	 (port (ly:outputter-port outputter)))
 
+    (if (ly:get-option 'dump-signatures)
+	(write-system-signatures basename (ly:paper-book-systems book) 1))
+  
     (output-scopes scopes fields basename)
     (display (file-header paper page-count #t) port)
-    (display "\n%%BeginDefaults
-%%PageMedia: a4
-%%EndDefaults\n" port)
+
+    
+    ;; don't do BeginDefaults PageMedia: A4 
+    ;; not necessary and wrong
+    
 
     (write-preamble paper #t port)
 
@@ -460,9 +484,11 @@
     (let* ((scale (ly:output-def-lookup paper 'output-scale))
 	   (box (map
 		 (lambda (x)
-		   (inexact->exact
-		    (round (/ (* x scale) (ly:bp 1))))) mmbox)))
-
+		   (if (or (nan? x) (inf? x))
+		       0
+		       (inexact->exact
+			(round (/ (* x scale) (ly:bp 1)))))) mmbox)))
+      
     (list (car box)
 	  (cadr box)
 	  (max (1+ (car box)) (caddr box))
@@ -492,8 +518,13 @@
 	   ;; the left-overshoot is to make sure that
 	   ;; bar numbers  stick out of margin uniformly.
 	   ;;
-	   (list (min left-overshoot (car xext))
-		 (car yext) (cdr xext) (cdr yext))))
+	   (list
+
+	    (if (ly:get-option 'pad-eps-boxes) 
+		(min left-overshoot (car xext))
+		(car xext))
+	    (car yext) (cdr xext) (cdr yext))))
+	 
 	 (rounded-bbox (to-bp-box bbox))
 	 (port (ly:outputter-port outputter))
 	 (header (eps-header paper rounded-bbox load-fonts?)))
@@ -513,7 +544,7 @@
 
     ;; skip booktitles.
     (if (and
-	 (not (ly:get-option 'preview-include-book-title))
+	 (not (ly:get-option 'include-book-title-preview))
 	 (pair? systems)
 	 (ly:prob-property (car systems) 'is-book-title #f))
 
@@ -564,12 +595,20 @@
 
 (define-public (convert-to-pdf book name)
   (let* ((defs (ly:paper-book-paper book))
-	 (papersizename (ly:output-def-lookup defs 'papersizename)))
+	 (landscape (ly:output-def-lookup defs 'landscape))
+	 (output-scale (ly:output-def-lookup defs 'output-scale))
+	 (convert (lambda (x) (* x output-scale (/ (ly:bp 1)))))
+	 
+	 (paper-width (convert (ly:output-def-lookup defs 'paper-width)))
+	 (paper-height (convert (ly:output-def-lookup defs 'paper-height)))
+
+	 (w (if landscape paper-height paper-width))
+	 (h (if landscape paper-width paper-height))
+	 )
 
     (if (equal? (basename name ".ps") "-")
 	(ly:warning (_ "can't convert <stdout> to ~S" "PDF"))
-	(postscript->pdf (if (string? papersizename) papersizename "a4")
-			 name))))
+	(postscript->pdf w h name))))
 
 (define-public (convert-to-png book name)
   (let* ((defs (ly:paper-book-paper book))
@@ -577,10 +616,13 @@
 	 (resolution (if (number? defs-resolution)
 			 defs-resolution
 			 (ly:get-option 'resolution)))
-	 (papersizename (ly:output-def-lookup defs 'papersizename)))
+	 (paper-width (ly:output-def-lookup defs 'paper-width))
+	 (paper-height (ly:output-def-lookup defs 'paper-height))
+	 (output-scale (ly:output-def-lookup defs 'output-scale)))
 
     (postscript->png resolution
-		     (if (string? papersizename) papersizename "a4")
+		     (* paper-width output-scale (/ (ly:bp 1)))
+		     (* paper-height output-scale (/ (ly:bp 1)))
 		     name)))
 
 (define-public (convert-to-dvi book name)