Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv24542/Backends/CLX

Modified Files: medium.lisp Log Message: Drawing optimizations, with a focus on eliminating clipping rectangle changes and transformation cache invalidations (the latter generally caused by the former). Shortcuts for special cases in d-g-w-o-internal, merge-text-styles, regions. Further mcclim-freetype optimization - minimize modification of picture-clip-rectangle and painting of the foreground tile (this used to happen for every single draw-text call). One or two optimizations in output record playback.

The mcclim-freetype changes require a fix to CLX, available in Christophe's CLX in darcs, or from here:

http://vintage-digital.com/hefner/mcclim/xrender-clip-state.diff

--- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/17 07:23:48 1.85 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/21 01:26:43 1.86 @@ -37,6 +37,7 @@ (defclass clx-medium (basic-medium) ((gc :initform nil) (picture :initform nil) + (clipping-region-dirty :initform t) (clipping-region-tmp :initform (vector 0 0 0 0) :documentation "This object is reused to avoid consing in the most common case when configuring the clipping region.") @@ -108,7 +109,7 @@ (let ((clipping-region (medium-device-region medium)) (tmp (slot-value medium 'clipping-region-tmp)) (port (port medium))) - (cond + (cond ((region-equal clipping-region +nowhere+) (setf (xlib:gcontext-clip-mask gc) #())) ((typep clipping-region 'standard-rectangle) @@ -135,8 +136,9 @@

(defmethod (setf medium-clipping-region) :after (region (medium clx-medium)) (declare (ignore region)) - (with-slots (gc) medium - (when gc (%set-gc-clipping-region medium gc)))) + (with-slots (#|gc|# clipping-region-dirty) medium + (setf clipping-region-dirty t) + #+NIL (when gc (%set-gc-clipping-region medium gc))))

(defgeneric medium-gcontext (medium ink)) @@ -155,7 +157,7 @@ (let* ((port (port medium)) (mirror (port-lookup-mirror port (medium-sheet medium))) (line-style (medium-line-style medium))) - (with-slots (gc) medium + (with-slots (gc clipping-region-dirty) medium (unless gc (setq gc (xlib:create-gcontext :drawable mirror)) ;; this is kind of false, since the :unit should be taken @@ -175,7 +177,9 @@ (let ((fn (text-style-to-X-font port (medium-text-style medium)))) (when (typep fn 'xlib:font) (setf (xlib:gcontext-font gc) fn))) - (%set-gc-clipping-region medium gc) + (when clipping-region-dirty + (%set-gc-clipping-region medium gc) + (setf clipping-region-dirty nil)) gc)))

(defmethod medium-gcontext ((medium clx-medium) (ink (eql +transparent-ink+))) @@ -620,7 +624,7 @@ (ink (medium-ink ,medium)) (gc (medium-gcontext ,medium ink))) line-style ink - (unwind-protect + (unwind-protect (unless (eql ink +transparent-ink+) (progn ,@body)) #+ignore(xlib:free-gcontext gc))))))