[mcclim-cvs] CVS update: mcclim/graphics.lisp

[Rudi Schlatte]

Update of /project/mcclim/cvsroot/mcclim
In directory common-lisp.net:/tmp/cvs-serv26755

Modified Files:
	graphics.lisp 
Log Message:
Implement with-output-to-pixmap with incomplete / missing size
arguments

Date: Sat Sep 10 13:53:15 2005
Author: rschlatte

Index: mcclim/graphics.lisp
diff -u mcclim/graphics.lisp:1.50 mcclim/graphics.lisp:1.51
--- mcclim/graphics.lisp:1.50	Wed Feb  2 12:33:58 2005
+++ mcclim/graphics.lisp	Sat Sep 10 13:53:15 2005
@@ -705,15 +705,28 @@
 ;;; mess. I think we need a pixmap output recording stream in order to do this
 ;;; right. -- moore
 (defmacro with-output-to-pixmap ((medium-var sheet &key width height) &body body)
-  `(let* ((pixmap (allocate-pixmap ,sheet ,width ,height)) ; XXX size might be unspecified -- APD
-	  (,medium-var (make-medium (port ,sheet) pixmap))
-	  (old-medium (sheet-medium ,sheet)))
-     (setf (slot-value pixmap 'medium) ,medium-var) ; hmm, [seems to work] -- BTS
-     (setf (%sheet-medium ,sheet) ,medium-var) ;is sheet a sheet-with-medium-mixin? --GB
-     (unwind-protect
-	 (progn , at body)
-       (setf (%sheet-medium ,sheet) old-medium));is sheet a sheet-with-medium-mixin? --GB
-     pixmap))
+  (if (and width height)
+      `(let* ((pixmap (allocate-pixmap ,sheet ,width ,height))
+              (,medium-var (make-medium (port ,sheet) pixmap))
+              (old-medium (sheet-medium ,sheet)))
+         (setf (slot-value pixmap 'medium) ,medium-var) ; hmm, [seems to work] -- BTS
+         (setf (%sheet-medium ,sheet) ,medium-var) ;is sheet a sheet-with-medium-mixin? --GB
+         (unwind-protect
+              (progn , at body)
+           (setf (%sheet-medium ,sheet) old-medium)) ;is sheet a sheet-with-medium-mixin? --GB
+         pixmap)
+      (let ((record (gensym "OUTPUT-RECORD-")))
+        ;; rudi (2005-09-05) What to do when only width or height are
+        ;; given?  And what's the meaning of medium-var?
+        `(let* ((,medium-var ,sheet)
+                (,record (with-output-to-output-record (,medium-var)
+                           , at body)))
+           (with-output-to-pixmap
+               (,medium-var 
+                ,sheet
+                :width ,(or width `(bounding-rectangle-width ,record))
+                :height ,(or height `(bounding-rectangle-height ,record)))
+             (replay-output-record ,record ,sheet))))))
 
 ;;; XXX This seems to be incorrect.
 ;;; This presumes that your drawing will completely fill the bounding rectangle