X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-ps.scm;h=c83b613cbd1ceca68b2157886cb05fb0b5bfa393;hb=67ff565b4ada90eeb753a866b22ddb4eaa8c6234;hp=128b1d410424ea26db70b68255b4f2d285638deb;hpb=040fcffaf3d2a7e95dc08c4162d32fa5bc37a32d;p=lilypond.git

diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index 128b1d4104..c83b613cbd 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -1,6 +1,6 @@
 ;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;; Copyright (C) 1998--2010 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;;                 Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
 ;;;; LilyPond is free software: you can redistribute it and/or modify
@@ -29,6 +29,7 @@
 
 (use-modules (guile)
 	     (ice-9 regex)
+	     (ice-9 optargs)
 	     (srfi srfi-1)
 	     (srfi srfi-13)
 	     (scm framework-ps)
@@ -44,7 +45,7 @@
 (define (str4 num)
   (if (or (nan? num) (inf? num))
       (begin
-	(ly:warning (_ "Found infinity or nan in output. Substituting 0.0"))
+	(ly:warning (_ "Found infinity or nan in output.  Substituting 0.0"))
 	(if (ly:get-option 'strict-infinity-checking)
 	    (exit 1))
 	"0.0")
@@ -102,30 +103,6 @@
 	  (- x2 x1) (- y2 y1)
 	  x1 y1 thick))
 
-(define (connected-shape pointlist thick x-scale y-scale connect fill)
-  (ly:format "~a~4f ~4f ~4f ~4f ~a ~a draw_connected_shape"
-    (string-concatenate
-      (map (lambda (x)
-             (apply (if (eq? (length x) 6)
-                        (lambda (x1 x2 x3 x4 x5 x6)
-                          (ly:format "~4f ~4f ~4f ~4f ~4f ~4f 6 "
-                                     x1
-                                     x2
-                                     x3
-                                     x4
-                                     x5
-                                     x6))
-                        (lambda (x1 x2)
-                           (ly:format "~4f ~4f 2 " x1 x2)))
-                    x))
-           (reverse pointlist)))
-      (length pointlist)
-      x-scale
-      y-scale
-      thick
-      (if connect "true" "false")
-      (if fill "true" "false")))
-
 (define (partial-ellipse x-radius y-radius start-angle end-angle thick connect fill)
   (ly:format "~a ~a ~4f ~4f ~4f ~4f ~4f draw_partial_ellipse"
         (if fill "true" "false")
@@ -284,7 +261,17 @@
 	     (cdr y)
 	     url))
 
-(define (path thickness exps)
+(define (page-link page-no x y)
+  (if (number? page-no)
+    (ly:format "~a ~a currentpoint vector_add  ~a ~a currentpoint vector_add ~a mark_page_link"
+	       (car x)
+	       (car y)
+	       (cdr x)
+	       (cdr y)
+	       page-no)
+    ""))
+
+(define* (path thickness exps #:optional (cap 'round) (join 'round) (fill? #f))
   (define (convert-path-exps exps)
     (if (pair? exps)
 	(let*
@@ -307,8 +294,29 @@
 		(convert-path-exps (drop rest arity))))
 	'()))
 
-
-  (ly:format
-   "gsave currentpoint translate 1 setlinecap ~a setlinewidth\n~l stroke grestore"
-   thickness
-   (convert-path-exps exps)))
+  (let ((cap-numeric (case cap ((butt) 0) ((round) 1) ((square) 2)
+		       (else (begin
+			       (ly:warning (_ "unknown line-cap-style: ~S")
+					   (symbol->string cap))
+			       1))))
+	(join-numeric (case join ((miter) 0) ((round) 1) ((bevel) 2)
+			(else (begin
+				(ly:warning (_ "unknown line-join-style: ~S")
+					    (symbol->string join))
+				1)))))
+    (ly:format
+     "gsave currentpoint translate
+~a setlinecap ~a setlinejoin ~a setlinewidth
+~l gsave stroke grestore ~a grestore"
+     cap-numeric
+     join-numeric
+     thickness
+     (convert-path-exps exps)
+     (if fill? "fill" ""))))
+
+(define (setscale x y)
+  (ly:format "gsave ~4l scale\n"
+	      (list x y)))
+
+(define (resetscale)
+  "grestore\n")