Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/output In directory common-lisp.net:/tmp/cvs-serv15409/mcclim/Backends/beagle/output
Modified Files: medium.lisp Log Message: Some tidying up of code. Rearranged EVENTS.LISP somewhat in preparation of better key event handling. Minor changes to rounding and coercing of coordinates in Beagle.
Date: Sat May 28 21:56:08 2005 Author: drose
Index: mcclim/Backends/beagle/output/medium.lisp diff -u mcclim/Backends/beagle/output/medium.lisp:1.3 mcclim/Backends/beagle/output/medium.lisp:1.4 --- mcclim/Backends/beagle/output/medium.lisp:1.3 Fri May 20 00:25:35 2005 +++ mcclim/Backends/beagle/output/medium.lisp Sat May 28 21:56:07 2005 @@ -477,10 +477,12 @@ (defun medium-copy-area-aux (from from-x from-y width height to to-x to-y) "Helper method for copying areas. 'from' and 'to' must both be 'mirror' objects. From and To coordinates must already be transformed as appropriate." - (let* ((source-region (ccl::make-ns-rect (+ from-x 0.5) (+ from-y 0.5) - width height)) - (target-point (ccl::make-ns-point (+ to-x 0.5) - (+ to-y 0.5))) + (let* ((source-region (ccl::make-ns-rect (coerce from-x 'short-float) + (coerce from-y 'short-float) + (coerce width 'short-float) + (coerce height 'short-float))) + (target-point (ccl::make-ns-point (coerce to-x 'short-float) + (coerce to-y 'short-float))) (bitmap-image (send from :copy-bitmap-from-region source-region))) (when (eql bitmap-image (%null-ptr)) (warn "medium.lisp -> medium-copy-area: failed to copy specified region (null bitmap)~%") @@ -489,7 +491,7 @@ (#_free source-region) (#_free target-point) (send bitmap-image 'release))) - +
(defmethod medium-copy-area ((from-drawable beagle-medium) from-x from-y width height (to-drawable beagle-medium) to-x to-y) @@ -595,16 +597,15 @@ prevents Cocoa from 'antialiasing' lines, making them thicker and a shade of grey. Ensures the return value is a short-float, as required by the Cocoa methods." -;; Interesting... I thought 'center of pixel' was 0.5, 1.5, ... n.5 -;; but this works much better with 0.0, 1.0, 2.0... -;; (coerce (+ (round-coordinate pt) 0.5) 'short-float)) - (coerce (round-coordinate pt) 'short-float)) + (coerce (+ (round-coordinate pt) 0.5) 'short-float)) +
(defun pixel-count (sz) "Ensures any value provided is rounded to the nearest unit, and returned as a short-float as required by the Cocoa methods." (coerce (round-coordinate sz) 'short-float))
+ ;;; Nabbed from CLX backend medium.lisp (declaim (inline round-coordinate)) (defun round-coordinate (x) @@ -618,6 +619,7 @@ Using CL:ROUND gives "random" results. Using "mercantile rounding" gives consistent results." (floor (+ x .5))) +
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;