Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/output In directory clnet:/tmp/cvs-serv3307/Backends/beagle/output

Modified Files: fonts.lisp medium.lisp Log Message: Try to make beagle backend run both on 64-bit and 32-bit clozure cl * Only tested on 64-bit clozure cl 1.2rc1 * hacked until clim-listener runs; chances are I missed many 'short-floats * Also don't (re)define symbols in the ccl package

--- /project/mcclim/cvsroot/mcclim/Backends/beagle/output/fonts.lisp 2007/12/18 10:54:22 1.4 +++ /project/mcclim/cvsroot/mcclim/Backends/beagle/output/fonts.lisp 2008/05/16 14:05:23 1.5 @@ -37,13 +37,13 @@ :serif "Times New Roman" :sans-serif "Verdana"))

-(defparameter *beagle-text-sizes* '(:normal 12.0 - :tiny 9.0 - :very-small 10.0 - :small 11.0 - :large 14.0 - :very-large 18.0 - :huge 24.0)) +(defparameter *beagle-text-sizes* '(:normal #.(cg-floatify 12.0) + :tiny #.(cg-floatify 9.0) + :very-small #.(cg-floatify 10.0) + :small #.(cg-floatify 11.0) + :large #.(cg-floatify 14.0) + :very-large #.(cg-floatify 18.0) + :huge #.(cg-floatify 24.0)))

(defparameter *beagle-native-fonts* (make-hash-table :test #'equal)) (defparameter *beagle-font-metrics* (make-hash-table :test #'equal)) --- /project/mcclim/cvsroot/mcclim/Backends/beagle/output/medium.lisp 2006/03/29 10:43:38 1.5 +++ /project/mcclim/cvsroot/mcclim/Backends/beagle/output/medium.lisp 2008/05/16 14:05:23 1.6 @@ -84,7 +84,7 @@

(defmethod (setf medium-line-style) :before (line-style (medium beagle-medium)) (unless (equal (medium-line-style medium) line-style) - (let ((width (coerce (line-style-thickness line-style) 'short-float)) + (let ((width (cg-floatify (line-style-thickness line-style))) (cap (%translate-cap-shape (line-style-cap-shape line-style))) (dashes (line-style-dashes line-style)) (join (%translate-joint-shape (line-style-joint-shape line-style)))) @@ -344,7 +344,7 @@ (defmethod %clim-opacity-from-design ((medium beagle-medium) design) (declare (ignore medium design)) ;; Just a stub for now. ::FIXME:: Need to ask on the list about this... - 1.0) + #.(cg-floatify 1.0))

(defmethod %clim-colour-from-design ((medium beagle-medium) (design climi::indirect-ink)) @@ -477,12 +477,8 @@ (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 (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))) + (let* ((source-region (make-ns-rect from-x from-y width height)) + (target-point (make-ns-point to-x to-y)) (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)~%") @@ -581,10 +577,10 @@ (do-sequence ((left top right bottom) coord-seq) (when (< right left) (rotatef left right)) (when (< top bottom) (rotatef top bottom)) - (let ((rect (ccl::make-ns-rect (pixel-center left) - (pixel-center bottom) - (pixel-count (- right left)) - (pixel-count (- top bottom))))) + (let ((rect (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 @@ -594,16 +590,15 @@ ;; ::FIXME:: Move these from here! (defun pixel-center (pt) "Ensure any ordinate provided sits on the center of a pixel. This -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." - (coerce (+ (round-coordinate pt) 0.5) 'short-float)) +prevents Cocoa from 'antialiasing' lines, making them thicker and a +shade of grey. Ensures the return value is an appropriate float type." + (cg-floatify (+ (round-coordinate pt) 0.5)))

(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)) +returned as an appropriate float type." + (cg-floatify (round-coordinate sz)))

;;; Nabbed from CLX backend medium.lisp @@ -657,10 +652,10 @@ (origin-y (- center-y radius-dy)) (width (* 2 radius-dx)) (height (* 2 radius-dy)) - (rect (ccl::make-ns-rect (pixel-center origin-x) - (pixel-center origin-y) - (pixel-count width) - (pixel-count height)))) + (rect (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 @@ -677,8 +672,8 @@ (pixel-center center-y)))) (send path :append-bezier-path-with-arc-with-center point :radius (pixel-count radius) - :start-angle (coerce (/ start-angle (/ pi 180)) 'short-float) - :end-angle (coerce (/ end-angle (/ pi 180)) 'short-float) + :start-angle (cg-floatify (/ start-angle (/ pi 180))) + :end-angle (cg-floatify (/ end-angle (/ pi 180))) :clockwise NIL))) (if filled (send mirror :fill-path path :in-colour colour) @@ -692,8 +687,7 @@ ;;; Draws a point on the medium 'medium'.

(defmethod medium-draw-point* ((medium beagle-medium) x y) - (let ((width (coerce (line-style-thickness (medium-line-style medium)) - 'short-float))) + (let ((width (cg-floatify (line-style-thickness (medium-line-style medium))))) (medium-draw-circle* medium x y (/ width 2) 0 (* 2 pi) t)))

@@ -707,7 +701,7 @@

(defmethod medium-draw-points* ((medium beagle-medium) coord-seq) (with-transformed-positions ((sheet-native-transformation (medium-sheet medium)) coord-seq) - (let ((width (coerce (line-style-thickness (medium-line-style medium)) 'short-float))) + (let ((width (cg-floatify (line-style-thickness (medium-line-style medium))))) (do-sequence ((x y) coord-seq) (medium-draw-circle* medium x y (/ width 2) 0 (* 2 pi) t)))))

@@ -775,10 +769,10 @@ (send mirror :draw-image colour :at-point (ns-make-point (pixel-center left) (pixel-center top))) (return-from medium-draw-rectangle* (values))) - (let ((rect (ccl::make-ns-rect (pixel-center left) - (pixel-center bottom) - (pixel-count (- right left)) - (pixel-count (- top bottom))))) + (let ((rect (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 @@ -853,8 +847,7 @@ (:baseline (- y baseline)) ;;; (:bottom y))) (:bottom (- y text-height)))) - (slet ((point (ns-make-point (coerce x 'short-float) - (coerce y 'short-float)))) + (slet ((point (ns-make-point (cg-floatify x) (cg-floatify y)))) (let ((objc-string (%make-nsstring (subseq string start end)))) ;; NB: draw-string-at-point uses upper-left as origin in a flipped ;; view.