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

[Duncan Rose]

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/output
In directory common-lisp.net:/tmp/cvs-serv24047/beagle/output

Modified Files:
	medium.lisp 
Log Message:
Some refactoring of events.lisp; made an effort to trawl for
memory allocations and ensure they're freed appropriately.
Estimate this to be around 70-80% done. Seems to give
performance and stability benefits.

Date: Fri May 20 00:25:35 2005
Author: drose

Index: mcclim/Backends/beagle/output/medium.lisp
diff -u mcclim/Backends/beagle/output/medium.lisp:1.2 mcclim/Backends/beagle/output/medium.lisp:1.3
--- mcclim/Backends/beagle/output/medium.lisp:1.2	Wed May 18 22:21:57 2005
+++ mcclim/Backends/beagle/output/medium.lisp	Fri May 20 00:25:35 2005
@@ -486,6 +486,8 @@
       (warn "medium.lisp -> medium-copy-area: failed to copy specified region (null bitmap)~%")
       (return-from medium-copy-area-aux nil))
     (send to :paste-bitmap bitmap-image :to-point target-point)
+    (#_free source-region)
+    (#_free target-point)
     (send bitmap-image 'release)))
   
 
@@ -581,7 +583,8 @@
 					 (pixel-center bottom)
 					 (pixel-count (- right left))
 					 (pixel-count (- top bottom)))))
-	    (send path :append-bezier-path-with-rect rect)))
+	    (send path :append-bezier-path-with-rect rect)
+	    (#_free rect)))
 	(if filled
 	    (send mirror :fill-path path :in-colour colour)
 	  (send mirror :stroke-path path :in-colour colour))))))
@@ -651,11 +654,13 @@
 	     (origin-x (- center-x radius-dx))
 	     (origin-y (- center-y radius-dy))
 	     (width (* 2 radius-dx))
-	     (height (* 2 radius-dy)))
-	(send path :append-bezier-path-with-oval-in-rect (ccl::make-ns-rect (pixel-center origin-x)
-									    (pixel-center origin-y)
-									    (pixel-count width)
-									    (pixel-count height)))
+	     (height (* 2 radius-dy))
+	     (rect (ccl::make-ns-rect (pixel-center origin-x)
+				      (pixel-center origin-y)
+				      (pixel-count width)
+				      (pixel-count height))))
+	(send path :append-bezier-path-with-oval-in-rect rect)
+	(#_free rect)
 	(if filled
 	    (send mirror :fill-path path :in-colour colour)
 	  (send mirror :stroke-path path :in-colour colour))))))
@@ -768,13 +773,15 @@
 	    (send mirror :draw-image colour :at-point (ns-make-point (pixel-center left)
 								     (pixel-center top)))
 	    (return-from medium-draw-rectangle* (values)))
-	  (send path :append-bezier-path-with-rect (ccl::make-ns-rect (pixel-center left)
-								      (pixel-center bottom)
-								      (pixel-count (- right left))
-								      (pixel-count (- top bottom))))
-	  (if filled
-	      (send mirror :fill-path path :in-colour colour)
-	    (send mirror :stroke-path path :in-colour colour)))))))
+	  (let ((rect (ccl::make-ns-rect (pixel-center left)
+					 (pixel-center bottom)
+					 (pixel-count (- right left))
+					 (pixel-count (- top bottom)))))
+	    (send path :append-bezier-path-with-rect rect)
+	    (#_free rect)
+	    (if filled
+		(send mirror :fill-path path :in-colour colour)
+	      (send mirror :stroke-path path :in-colour colour))))))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;