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))))