Index: Backends/PostScript/class.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/class.lisp,v retrieving revision 1.6 diff -u -r1.6 class.lisp --- Backends/PostScript/class.lisp 4 Jul 2002 06:57:43 -0000 1.6 +++ Backends/PostScript/class.lisp 31 Aug 2005 20:24:31 -0000 @@ -84,7 +84,9 @@ *default-postscript-title*)) (for (or (getf header-comments :for) *default-postscript-for*)) - (region (paper-region device-type orientation)) + (region (case device-type + ((:eps) +everywhere+) + (t (paper-region device-type orientation)))) (transform (make-postscript-transformation device-type orientation))) (make-instance 'postscript-stream :file-stream file-stream Index: Backends/PostScript/graphics.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/graphics.lisp,v retrieving revision 1.13 diff -u -r1.13 graphics.lisp --- Backends/PostScript/graphics.lisp 1 Aug 2005 16:50:43 -0000 1.13 +++ Backends/PostScript/graphics.lisp 31 Aug 2005 20:24:31 -0000 @@ -169,23 +169,25 @@ "Native transformation") ;;; Postscript output utilities -(defmacro with-graphics-state ((medium) &body body) - `(invoke-with-graphics-state ,medium +(defmacro with-graphics-state ((stream) &body body) + `(invoke-with-graphics-state ,stream (lambda () ,@body))) -(defun postscript-save-graphics-state (medium) - (push (copy-list (postscript-medium-graphics-state medium)) - (slot-value (medium-sheet medium) 'graphics-state-stack)) - (format (postscript-medium-file-stream medium) "gsave~%")) - -(defun postscript-restore-graphics-state (medium) - (pop (slot-value (medium-sheet medium) 'graphics-state-stack)) - (format (postscript-medium-file-stream medium) "grestore~%")) +(defun postscript-save-graphics-state (stream) + (push (copy-list (first (slot-value stream 'graphics-state-stack))) + (slot-value stream 'graphics-state-stack)) + (when (stream-drawing-p stream) + (format (postscript-stream-file-stream stream) "gsave~%"))) + +(defun postscript-restore-graphics-state (stream) + (pop (slot-value stream 'graphics-state-stack)) + (when (stream-drawing-p stream) + (format (postscript-stream-file-stream stream) "grestore~%"))) -(defun invoke-with-graphics-state (medium continuation) - (postscript-save-graphics-state medium) +(defun invoke-with-graphics-state (stream continuation) + (postscript-save-graphics-state stream) (funcall continuation) - (postscript-restore-graphics-state medium)) + (postscript-restore-graphics-state stream)) ;;; Postscript path functions @@ -346,8 +348,8 @@ ;; does only one level of saving graphics state, so we can restore ;; and save again GS to obtain an initial CP. It is ugly, but I see ;; no other way now. -- APD, 2002-02-11 - (postscript-restore-graphics-state medium) - (postscript-save-graphics-state medium) + (postscript-restore-graphics-state (medium-sheet medium)) + (postscript-save-graphics-state (medium-sheet medium)) (postscript-set-clipping-region stream (medium-clipping-region medium))) @@ -494,7 +496,7 @@ (let ((*transformation* (sheet-native-transformation (medium-sheet medium)))) (let ((file-stream (postscript-medium-file-stream medium))) (postscript-actualize-graphics-state file-stream medium :color :text-style) - (with-graphics-state (medium) + (with-graphics-state ((medium-sheet medium)) #+ignore (when transform-glyphs ;; Index: Backends/PostScript/paper.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/paper.lisp,v retrieving revision 1.2 diff -u -r1.2 paper.lisp --- Backends/PostScript/paper.lisp 31 May 2002 02:32:10 -0000 1.2 +++ Backends/PostScript/paper.lisp 31 Aug 2005 20:24:31 -0000 @@ -55,6 +55,9 @@ (make-rectangle* 0 0 width height))) (defun make-postscript-transformation (paper-size-name orientation) + (when (eq paper-size-name :eps) + (return-from make-postscript-transformation + (make-reflection-transformation* 0 0 1 0))) (multiple-value-bind (width height) (paper-size paper-size-name) (case orientation (:portrait (make-3-point-transformation* @@ -63,4 +66,4 @@ (:landscape (make-3-point-transformation* 0 0 0 width height 0 width height 0 height width 0)) - (t (error "Unknown orientation"))))) \ No newline at end of file + (t (error "Unknown orientation"))))) Index: Backends/PostScript/sheet.lisp =================================================================== RCS file: /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp,v retrieving revision 1.9 diff -u -r1.9 sheet.lisp --- Backends/PostScript/sheet.lisp 1 Apr 2004 04:26:46 -0000 1.9 +++ Backends/PostScript/sheet.lisp 31 Aug 2005 20:24:31 -0000 @@ -58,29 +58,43 @@ orientation header-comments))) (unwind-protect (progn + (with-output-recording-options (stream :record t :draw nil) + (with-graphics-state (stream) + ;; we need at least one level of saving -- APD, 2002-02-11 + (funcall continuation stream))) (with-slots (file-stream title for orientation paper) stream - (format file-stream "%!PS-Adobe-3.0~%") + (format file-stream "%!PS-Adobe-3.0~@[ EPSF-3.0~*~]~%" + (eq device-type :eps)) (format file-stream "%%Creator: McCLIM~%") (format file-stream "%%Title: ~A~%" title) (format file-stream "%%For: ~A~%" for) (format file-stream "%%LanguageLevel: 2~%") - (multiple-value-bind (width height) - (paper-size paper) - (format file-stream "%%BoundingBox: 0 0 ~A ~A~%" width height) - (format file-stream "%%DocumentMedia: ~A ~A ~A 0 () ()~%" - paper width height)) - (format file-stream "%%Orientation: ~A~%" - (ecase orientation - (:portrait "Portrait") - (:landscape "Landscape"))) - (format file-stream "%%Pages: (atend)~%") + (case paper + ((:eps) + (let ((record (stream-output-history stream))) + (multiple-value-bind (lx ly ux uy) (bounding-rectangle* record) + (format file-stream "%%BoundingBox: ~A ~A ~A ~A~%" + (floor lx) (floor (- uy)) + (ceiling ux) (ceiling (- ly)))))) + (t + (multiple-value-bind (width height) + (paper-size paper) + (format file-stream "%%BoundingBox: 0 0 ~A ~A~%" width height) + (format file-stream "%%DocumentMedia: ~A ~A ~A 0 () ()~%" + paper width height)) + (format file-stream "%%Orientation: ~A~%" + (ecase orientation + (:portrait "Portrait") + (:landscape "Landscape"))) + (format file-stream "%%Pages: (atend)~%"))) (format file-stream "%%DocumentNeededResources: (atend)~%") (format file-stream "%%EndComments~%~%") (write-postcript-dictionary file-stream) - (start-page stream)) - (with-graphics-state ((sheet-medium stream)) - ;; we need at least one level of saving -- APD, 2002-02-11 - (funcall continuation stream))) + (start-page stream) + (let ((record (stream-output-history stream))) + (with-output-recording-options (stream :draw t :record nil) + (with-graphics-state (stream) + (replay record stream)))))) (with-slots (file-stream current-page) stream (format file-stream "end~%showpage~%~%") (format file-stream "%%Trailer~%")