[mcclim-cvs] CVS mcclim/Backends/beagle/native-panes
rschlatte
rschlatte at common-lisp.net
Fri May 16 14:05:23 UTC 2008
Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes
In directory clnet:/tmp/cvs-serv3307/Backends/beagle/native-panes
Modified Files:
beagle-fundamental-button-pane.lisp
beagle-scroll-bar-pane.lisp beagle-slider-pane.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/native-panes/beagle-fundamental-button-pane.lisp 2005/06/12 16:53:26 1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-fundamental-button-pane.lisp 2008/05/16 14:05:15 1.2
@@ -77,10 +77,11 @@
(defun %beagle-get-label-size (label sheet)
- (let ((retsize 0.0)
+ (let ((retsize (cg-floatify 0.0))
(dictionary (reuse-attribute-dictionary (sheet-medium sheet)
(send (@class ns-font)
- :system-font-of-size 0.0))))
+ :system-font-of-size
+ (cg-floatify 0.0)))))
(slet ((label-size (send (ccl::%make-nsstring label)
:size-with-attributes dictionary)))
(setf retsize label-size)
@@ -100,12 +101,13 @@
(defmethod compose-space ((pb beagle-push-button-pane) &key width height)
(declare (ignore width height))
;; - magic numbers are from the HIG
- (let ((column-spacing 12.0)
- (row-spacing 12.0)
- (standard-width-sans-ends 41.0)
- (standard-end-size 28.0)
- (standard-width 69.0) ; width of OK, Cancel buttons
- (standard-height 20.0)
+ (let ((column-spacing #.(cg-floatify 12.0))
+ (row-spacing #.(cg-floatify 12.0))
+ (standard-width-sans-ends #.(cg-floatify 41.0))
+ (standard-end-size #.(cg-floatify 28.0))
+ ; width of OK, Cancel buttons
+ (standard-width #.(cg-floatify 69.0))
+ (standard-height #.(cg-floatify 20.0))
(label-size (%beagle-get-label-size (gadget-label pb) pb)))
(let ((width (if (< (pref label-size :<NSS>ize.width) standard-width-sans-ends)
standard-width-sans-ends
@@ -125,10 +127,10 @@
(sheet beagle-push-button-pane))
(let* ((q (compose-space sheet))
- (rect (ccl::make-ns-rect 0.0
- 0.0
- (coerce (space-requirement-width q) 'short-float)
- (coerce (space-requirement-height q) 'short-float)))
+ (rect (make-ns-rect 0.0
+ 0.0
+ (space-requirement-width q)
+ (space-requirement-height q)))
(mirror (make-instance 'lisp-button :with-frame rect)))
(send mirror 'retain)
--- /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp 2006/04/25 18:50:31 1.9
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-scroll-bar-pane.lisp 2008/05/16 14:05:17 1.10
@@ -21,10 +21,10 @@
;; bar; otherwise we get a :vertical bar.
(let* ((q (compose-space sheet))
- (rect (ccl::make-ns-rect 0.0
- 0.0
- (space-requirement-width q)
- (space-requirement-height q)))
+ (rect (make-ns-rect 0.0
+ 0.0
+ (space-requirement-width q)
+ (space-requirement-height q)))
(mirror (make-instance 'lisp-scroller :with-frame rect)))
(send mirror 'retain)
@@ -33,7 +33,7 @@
(send mirror :set-enabled #$YES)
;; Make knob fill pane initially.
- (send mirror :set-float-value 0.0 :knob-proportion 1.0)
+ (send mirror :set-float-value 0.0 :knob-proportion #.(cg-floatify 1.0))
(setf (toolkit-object sheet) mirror)
(setf (view-lisp-scroller mirror) sheet)
@@ -99,7 +99,7 @@
(/ ts (+ range ts)))))
(send (toolkit-object scroll-bar)
:set-float-value (coerce (clamp value 0.0 1.0) 'short-float)
- :knob-proportion (coerce (clamp loz-size 0.0 1.0) 'short-float))))
+ :knob-proportion (cg-floatify (clamp loz-size 0.0 1.0)))))
(defmethod (setf gadget-min-value) :after
(new-value (pane beagle-scroll-bar-pane))
@@ -153,7 +153,7 @@
(/ size range))))
(send (toolkit-object gadget)
:set-float-value (coerce position 'short-float)
- :knob-proportion (coerce loz-size 'short-float)))))
+ :knob-proportion (cg-floatify loz-size)))))
;;; Called in the Cocoa App thread.
--- /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-slider-pane.lisp 2005/06/12 13:27:42 1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/native-panes/beagle-slider-pane.lisp 2008/05/16 14:05:18 1.2
@@ -26,10 +26,10 @@
;; bar; otherwise we get a :vertical bar.
(let* ((q (compose-space sheet))
- (rect (ccl::make-ns-rect 0.0
- 0.0
- (coerce (space-requirement-width q) 'short-float)
- (coerce (space-requirement-height q) 'short-float)))
+ (rect (make-ns-rect 0.0
+ 0.0
+ (space-requirement-width q)
+ (space-requirement-height q)))
(mirror (make-instance 'lisp-slider :with-frame rect)))
(send mirror 'retain)
More information about the Mcclim-cvs
mailing list