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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;