[mcclim-cvs] CVS mcclim

[ahefner]

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

Modified Files:
	graphics.lisp 
Log Message:
Fix draw-pattern* on streams with non-translation transformations,
according to my reading of the spec.



--- /project/mcclim/cvsroot/mcclim/graphics.lisp	2006/11/17 20:33:24	1.55
+++ /project/mcclim/cvsroot/mcclim/graphics.lisp	2006/12/23 11:41:23	1.56
@@ -1008,12 +1008,18 @@
 (defmethod medium-draw-pattern* (medium pattern x y)
   (let ((width  (pattern-width pattern))
         (height (pattern-height pattern)))
-    #+NIL ;; debugging aid.
-    (draw-rectangle* medium x y (+ x width) (+ y height)
-                     :filled t
-                     :ink +red+)
-    (draw-rectangle* medium x y (+ x width) (+ y height)
-                     :filled t
-                     :ink (transform-region
-                           (make-translation-transformation x y)
-                           pattern))))
+    ;; As I read the spec, the pattern itself is not transformed, so
+    ;; we should draw the full (untransformed) pattern at the tranformed
+    ;; x/y coordinates. This requires we revert to the identity transformation
+    ;; before drawing the rectangle. -Hefner
+    (with-transformed-position ((medium-transformation medium) x y)
+      (with-identity-transformation (medium)
+	#+NIL ;; debugging aid.
+	(draw-rectangle* medium x y (+ x width) (+ y height)
+			 :filled t
+			 :ink +red+)
+	(draw-rectangle* medium x y (+ x width) (+ y height)
+			 :filled t
+			 :ink (transform-region
+			       (make-translation-transformation x y)
+			       pattern))))))