[mcclim-cvs] CVS update: mcclim/Backends/CLX/medium.lisp

[Timothy Moore]

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

Modified Files:
	medium.lisp 
Log Message:
 Alastair Bridgewater's fix to medium-clear-area. Fixes Paolo bug clx-medium-clear-area-transform
Date: Thu Feb 17 22:23:29 2005
Author: tmoore

Index: mcclim/Backends/CLX/medium.lisp
diff -u mcclim/Backends/CLX/medium.lisp:1.65 mcclim/Backends/CLX/medium.lisp:1.66
--- mcclim/Backends/CLX/medium.lisp:1.65	Tue Jan 18 14:35:26 2005
+++ mcclim/Backends/CLX/medium.lisp	Thu Feb 17 22:23:29 2005
@@ -965,13 +965,19 @@
   (xlib:display-force-output (clx-port-display (port medium))))
 
 (defmethod medium-clear-area ((medium clx-medium) left top right bottom)
-  (let ((min-x (round-coordinate (min left right)))
-	(min-y (round-coordinate (min top bottom)))
-	(max-x (round-coordinate (max left right)))
-	(max-y (round-coordinate (max top bottom))))
-    (xlib:clear-area (port-lookup-mirror (port medium) (medium-sheet medium))
-		     :x min-x :y min-y
-		     :width (- max-x min-x) :height (- max-y min-y))))
+  (let ((tr (sheet-native-transformation (medium-sheet medium))))
+    (with-transformed-position (tr left top)
+      (with-transformed-position (tr right bottom)
+	(let ((min-x (round-coordinate (min left right)))
+	      (min-y (round-coordinate (min top bottom)))
+	      (max-x (round-coordinate (max left right)))
+	      (max-y (round-coordinate (max top bottom))))
+	  (xlib:clear-area (port-lookup-mirror (port medium)
+					       (medium-sheet medium))
+			   :x (max #x-8000 (min #x7fff min-x))
+			   :y (max #x-8000 (min #x7fff min-y))
+			   :width (max 0 (min #xffff (- max-x min-x)))
+			   :height (max 0 (min #xffff (- max-y min-y)))))))))
 
 (defmethod medium-beep ((medium clx-medium))
   (xlib:bell (clx-port-display (port medium))))