[mcclim-cvs] CVS mcclim/Backends/PostScript

crhodes crhodes at common-lisp.net
Tue Mar 7 14:59:30 UTC 2006


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

Modified Files:
	sheet.lisp 
Log Message:
Make our EPS files always have lower bounds of 0.


--- /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp	2005/12/30 18:02:39	1.11
+++ /project/mcclim/cvsroot/mcclim/Backends/PostScript/sheet.lisp	2006/03/07 14:59:29	1.12
@@ -55,7 +55,8 @@
   (let* ((port (find-port :server-path `(:ps :stream ,file-stream)))
          (stream (make-postscript-stream file-stream port device-type
                                          multi-page scale-to-fit
-                                         orientation header-comments)))
+                                         orientation header-comments))
+         translate-x translate-y)
     (unwind-protect
          (progn
            (with-output-recording-options (stream :record t :draw nil)
@@ -73,9 +74,12 @@
                ((:eps)
                 (let ((record (stream-output-history stream)))
                   (multiple-value-bind (lx ly ux uy) (bounding-rectangle* record)
+                    (setf translate-x (- (ceiling lx))
+                          translate-y (ceiling uy))
                     (format file-stream "%%BoundingBox: ~A ~A ~A ~A~%" 
-                            (floor lx) (- (ceiling uy))
-                            (ceiling ux) (- (floor ly))))))
+                            0 0
+                            (+ translate-x (floor lx))
+                            (- translate-y (floor ly))))))
                (t
                 (multiple-value-bind (width height)
                     (paper-size paper)
@@ -93,6 +97,7 @@
              (dolist (text-style (device-fonts (sheet-medium stream)))
                (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)




More information about the Mcclim-cvs mailing list