Update of /project/mcclim/cvsroot/mcclim/Backends/PostScript In directory clnet:/tmp/cvs-serv12535/Backends/PostScript

Modified Files: class.lisp sheet.lisp Log Message: New new-page handling for the Postscript backend.

Initially from hefner; somewhat frobbed to make EPS continue to work too.

--- /project/mcclim/cvsroot/mcclim/Backends/PostScript/class.lisp 2006/03/29 10:43:38 1.9 +++ /project/mcclim/cvsroot/mcclim/Backends/PostScript/class.lisp 2007/11/27 19:49:33 1.10 @@ -79,7 +79,8 @@ :reader sheet-native-transformation) (current-page :initform 0) (document-fonts :initform '()) - (graphics-state-stack :initform '()))) + (graphics-state-stack :initform '()) + (pages :initform nil :accessor postscript-pages)))

(defun make-postscript-stream (file-stream port device-type multi-page scale-to-fit --- /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp 2006/04/01 21:07:04 1.15 +++ /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp 2007/11/27 19:49:33 1.16 @@ -62,7 +62,9 @@ (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))) + (funcall continuation stream) + (unless (eql (slot-value stream 'paper) :eps) + (new-page stream)))) ; Close final page. (with-slots (file-stream title for orientation paper) stream (format file-stream "%!PS-Adobe-3.0~@[ EPSF-3.0~*~]~%" (eq device-type :eps)) @@ -98,10 +100,17 @@ (write-font-to-postscript-stream (sheet-medium stream) text-style)) (start-page stream) (format file-stream "~@[~A ~]~@[~A translate~%~]" translate-x translate-y) - (let ((record (stream-output-history stream))) - (with-output-recording-options (stream :draw t :record nil) - (with-graphics-state (stream) - (replay record stream)))))) + + (with-output-recording-options (stream :draw t :record nil) + (with-graphics-state (stream) + (case paper + ((:eps) (replay (stream-output-history stream) stream)) + (t (let ((last-page (first (postscript-pages stream)))) + (dolist (page (reverse (postscript-pages stream))) + (replay page stream) + (unless (eql page last-page) + (emit-new-page stream)))))))))) + (with-slots (file-stream current-page) stream (format file-stream "end~%showpage~%~%") (format file-stream "%%Trailer~%") @@ -118,39 +127,21 @@ (format file-stream "%%Page: ~D ~:*~D~%" (incf current-page)) (format file-stream "~A begin~%" *dictionary-name*)))

-;;; We define a new output-record class and a method on -;;; replay-output-record so that we can record calls to new-page. -;;; -;;; FIXME: I (CSR) think that this works because we stuff this in a -;;; sequence-output-record, so that the output records are replayed -;;; in order. That's fine, but if someone ever gets round to implementing -;;; R-trees or similar, this method for storing the order of events might -;;; stop working. CSR, 2005-12-30 -(defclass new-page-record (climi::basic-output-record) - ()) - -(defmethod replay-output-record ((record new-page-record) stream - &optional (region nil) (x-offset 0) (y-offset 0)) - (declare (ignore region x-offset y-offset)) - (new-page stream)) - -(defun new-page (stream) - (when (stream-recording-p stream) - (stream-add-output-record stream (make-instance 'new-page-record))) - (when (stream-drawing-p stream) - ;; FIXME: it is necessary to do smth with GS -- APD, 2002-02-11 - ;; FIXME^2: what do you mean by that? -- TPD, 2005-12-23 - (postscript-restore-graphics-state stream) - (format (postscript-stream-file-stream stream) "end~%showpage~%") - (start-page stream) - (postscript-save-graphics-state stream) - ;; If we call clear-output-record here, it wipes all remaining - ;; output, so all pages after the first are blank. But I don't - ;; know quite what the original purpose of the call was, so, - ;; FIXME. -- TPD 2005-12-23 - #-(and) (clear-output-record (stream-output-history stream))) +(defun new-page (stream) + (push (stream-output-history stream) (postscript-pages stream)) + (let ((history (make-instance 'standard-tree-output-history :stream stream))) + (setf (slot-value stream 'climi::output-history) history + (stream-current-output-record stream) history)) (setf (stream-cursor-position stream) (values 0 0)))

+(defun emit-new-page (stream) + ;; FIXME: it is necessary to do smth with GS -- APD, 2002-02-11 + ;; FIXME^2: what do you mean by that? -- TPD, 2005-12-23 + (postscript-restore-graphics-state stream) + (format (postscript-stream-file-stream stream) "end~%showpage~%") + (start-page stream) + (postscript-save-graphics-state stream)) +  ;;;; Output Protocol (defmethod medium-drawable ((medium postscript-medium))