[mcclim-cvs] CVS mcclim

[ahefner]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv14962

Modified Files:
	recording.lisp 
Log Message:
Apparently, when rgb-designs were merged into the core of mcclim, the
output recording definitions got left out.


--- /project/mcclim/cvsroot/mcclim/recording.lisp	2008/04/13 07:32:40	1.141
+++ /project/mcclim/cvsroot/mcclim/recording.lisp	2008/08/19 15:56:50	1.142
@@ -1718,6 +1718,33 @@
        (if-supplied (pattern pattern)
          (eq (slot-value record 'pattern) pattern))))
 
+;;;; RGB images
+
+(def-grecording draw-image-design (() image-design x y) ()
+  (let ((width (image-width (image image-design)))
+        (height (image-height (image image-design)))
+	(transform (medium-transformation medium)))
+    (setf (values x y) (transform-position transform x y))
+    (values x y (+ x width) (+ y height))))
+
+(defmethod* (setf output-record-position) :around
+            (nx ny (record draw-image-design-output-record))
+  (with-standard-rectangle* (:x1 x1 :y1 y1) record
+    (with-slots (x y) record
+      (let ((dx (- nx x1))
+            (dy (- ny y1)))
+        (multiple-value-prog1 (call-next-method)
+          (incf x dx)
+          (incf y dy))))))
+
+(defrecord-predicate draw-image-design-output-record (x y image-design)
+  (and (if-supplied (x coordinate)
+	 (coordinate= (slot-value record 'x) x))
+       (if-supplied (y coordinate)
+	 (coordinate= (slot-value record 'y) y))
+       (if-supplied (image-design rgb-image-design)
+         (eq (slot-value record 'image-design) image-design))))
+
 ;;;; Text
 
 (def-grecording draw-text ((gs-text-style-mixin) string point-x point-y start end