Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing In directory clnet:/tmp/cvs-serv3307/Backends/beagle/windowing Modified Files: mirror.lisp port.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/windowing/mirror.lisp 2006/03/29 10:43:38 1.7 +++ /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing/mirror.lisp 2008/05/16 14:05:27 1.8 @@ -235,8 +235,8 @@ (y 0) (width (space-requirement-width q)) (height (space-requirement-height q)) - (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) - (pixel-count width) (pixel-count height))) + (rect (make-ns-rect (pixel-center x) (pixel-center y) + (pixel-count width) (pixel-count height))) (name (%make-nsstring (frame-pretty-name frame))) (top-level-frame (%beagle-make-window (beagle-port-screen port) rect @@ -266,8 +266,8 @@ (y 0) (width (space-requirement-width q)) (height (space-requirement-height q)) - (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) - (pixel-count width) (pixel-count height))) + (rect (make-ns-rect (pixel-center x) (pixel-center y) + (pixel-count width) (pixel-count height))) (menu-frame (%beagle-make-window (beagle-port-screen port) rect :decorated nil)) (clim-mirror (make-instance 'lisp-view :with-frame rect))) (send clim-mirror 'retain) @@ -294,8 +294,8 @@ (q (compose-space sheet)) (width (space-requirement-width q)) (height (space-requirement-height q)) - (rect (ccl::make-ns-rect (pixel-center x) (pixel-center y) - (pixel-count width) (pixel-count height))) + (rect (make-ns-rect (pixel-center x) (pixel-center y) + (pixel-count width) (pixel-count height))) (mirror (make-instance view :with-frame rect))) (#_free rect) (send mirror 'retain) @@ -331,8 +331,8 @@ (defmethod realize-mirror ((port beagle-port) (pixmap pixmap)) (when (null (port-lookup-mirror port pixmap)) - (let* ((width (coerce (pixmap-width pixmap) 'short-float)) - (height (coerce (pixmap-height pixmap) 'short-float)) + (let* ((width (cg-floatify (pixmap-width pixmap))) + (height (cg-floatify (pixmap-height pixmap))) (mirror (make-instance 'lisp-image))) ;; :with-frame rect))) (send mirror 'retain) (slet ((size (ccl::ns-make-size width height))) @@ -432,9 +432,8 @@ ;; We've handled the frame (if necessary) - now resize the mirror itself. (slet ((frame-size (send mirror 'frame))) - (rlet ((size :<NSS>ize :width (coerce (floor (bounding-rectangle-width mirror-region)) - 'short-float) - :height (coerce (floor (bounding-rectangle-height mirror-region)) 'short-float))) + (rlet ((size :<NSS>ize :width (cg-floatify (floor (bounding-rectangle-width mirror-region))) + :height (cg-floatify (floor (bounding-rectangle-height mirror-region))))) ;; ignore this (for now) #+nil (when (and (equal (pref frame-size :<NSR>ect.size.width) (pref size :<NSS>ize.width)) @@ -448,9 +447,8 @@ (slet ((frame-rect (send mirror 'frame))) (rlet ((rect :<NSR>ect :origin.x (pref frame-rect :<NSR>ect.origin.x) :origin.y (pref frame-rect :<NSR>ect.origin.y) - :size.width (coerce (floor (bounding-rectangle-width mirror-region)) 'short-float) - :size.height (coerce (floor (bounding-rectangle-height mirror-region)) - 'short-float))) + :size.width (cg-floatify (floor (bounding-rectangle-width mirror-region))) + :size.height (cg-floatify (floor (bounding-rectangle-height mirror-region))))) (send (send mirror 'window) :set-frame (send (send mirror 'window) :frame-rect-for-content-rect rect @@ -547,7 +545,7 @@ (let* ((app-tls (frame-top-level-sheet (pane-frame sheet))) (tls-mirror (port-lookup-mirror port app-tls)) (tls-window (send tls-mirror 'window)) - (origin-pt (ccl::make-ns-point 0.0 0.0))) + (origin-pt (make-ns-point 0.0 0.0))) (slet ((frame-pt (send tls-window :convert-base-to-screen origin-pt)) (tls-bounds (send tls-mirror 'bounds))) (#_free origin-pt) @@ -560,8 +558,7 @@ ;;; (setf y (+ y frame-y)) (setf y (- (+ frame-y tls-height) y))))))) - (let ((point (ccl::make-ns-point (coerce x 'short-float) - (coerce y 'short-float)))) + (let ((point (make-ns-point x y))) (send (send mirror 'window) :set-frame-top-left-point point) (#_free point))))) @@ -606,11 +603,9 @@ (%beagle-port-move-mirror-window port mirror mirror-transformation) (slet ((mirror-bounds (send mirror 'bounds)) (frame-origin (send mirror 'frame))) ;position + size _in parent_ - (let* ((x (coerce (floor (nth-value 0 (transform-position mirror-transformation 0 0))) - 'short-float)) - (y (coerce (floor (nth-value 1 (transform-position mirror-transformation 0 0))) - 'short-float)) - (point (ccl::make-ns-point x y))) + (let* ((x (floor (nth-value 0 (transform-position mirror-transformation 0 0)))) + (y (floor (nth-value 1 (transform-position mirror-transformation 0 0)))) + (point (make-ns-point x y))) ;; Skip this (for now...) #+nil (when (and (equal (pref frame-origin :<NSR>ect.origin.x) x) --- /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing/port.lisp 2007/12/18 10:54:22 1.7 +++ /project/mcclim/cvsroot/mcclim/Backends/beagle/windowing/port.lisp 2008/05/16 14:05:28 1.8 @@ -164,16 +164,16 @@ ;;; From CLX/port.lisp -(defun %beagle-pixel (port color &key (alpha 1.0)) +(defun %beagle-pixel (port color &key (alpha #.(cg-floatify 1.0))) (let* ((table (slot-value port 'color-table)) (nscol (gethash color table))) (when (null nscol) (setf (gethash color table) (multiple-value-bind (r g b) (color-rgb color) - (let ((nsc (send (@class ns-color) :color-with-calibrated-red (coerce r 'short-float) - :green (coerce g 'short-float) - :blue (coerce b 'short-float) - :alpha (coerce alpha 'short-float)))) + (let ((nsc (send (@class ns-color) :color-with-calibrated-red (cg-floatify r) + :green (cg-floatify g) + :blue (cg-floatify b) + :alpha (cg-floatify alpha)))) (send nsc 'retain))))) (gethash color table)))