[mcclim-cvs] CVS mcclim/Backends/beagle

rschlatte rschlatte at common-lisp.net
Fri May 16 14:05:11 UTC 2008


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

Modified Files:
	cocoa-util.lisp package.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/cocoa-util.lisp	2005/06/05 19:52:54	1.4
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/cocoa-util.lisp	2008/05/16 14:05:09	1.5
@@ -23,30 +23,33 @@
 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
 ;;; Boston, MA  02111-1307  USA.
 
-(in-package :ccl)
+(in-package :beagle)
+
+(declaim (inline cg-floatify))
+(defun cg-floatify (cg-float-value)
+  (float cg-float-value ns:+cgfloat-zero+))
 
-;; Make an NSRect structure with the origin at (x, y) and with the width and height
-;; specified.
 (defun make-ns-rect (x y width height)
   "Make a Cocoa NSRect structure with the origin at (x, y) and with the
 width and height specified. The memory for any structure created with
 this method must be released by the user (using (#_free))."
-  (make-record :<NSR>ect :origin.x    x
-                         :origin.y    y
-			 :size.width  width
-			 :size.height height))
+  (ccl:make-record :<NSR>ect
+		   :origin.x    (cg-floatify x)
+		   :origin.y    (cg-floatify y)
+		   :size.width  (cg-floatify width)
+		   :size.height (cg-floatify height)))
 
 (defun make-ns-point (x y)
   "Make a Cocoa NSPoint structure populated with x and y provided.
 The memory for any structure created with this method must be released
 by the user (using (#_free))."
-  (make-record :<NSP>oint :x x :y y))
+  (ccl:make-record :<NSP>oint :x (cg-floatify x) :y (cg-floatify y)))
 
 ;; Stolen from Bosco "main.lisp".
 (defun description (c)
-  (with-autorelease-pool
-   (lisp-string-from-nsstring
-	(send c 'description))))
+  (ccl::with-autorelease-pool
+    (ccl::lisp-string-from-nsstring
+     (ccl::send c 'description))))
 
 (defun nslog (c)
   (let* ((rep (format nil "~a" c)))
--- /project/mcclim/cvsroot/mcclim/Backends/beagle/package.lisp	2007/12/18 10:54:21	1.6
+++ /project/mcclim/cvsroot/mcclim/Backends/beagle/package.lisp	2008/05/16 14:05:09	1.7
@@ -1,18 +1,5 @@
 ;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (require :cocoa))
-
-;;; START - Cribbed from framework/cocoa-support.lisp
-(in-package "CCL")
-(defun nslog (c)
-  "Writes a string message to the OSX console log."
-  (let* ((rep (format nil "~a" c)))
-    (with-cstrs ((str rep))
-      (with-nsstr (nsstr str (length rep))
-	(#_NSLog #@"Logging: %@" :address nsstr)))))
-;;; END
-
 (in-package :common-lisp-user)
 
 (defpackage :beagle
@@ -84,11 +71,9 @@
   (:import-from :ccl
 				#:@class
 				#:define-objc-method
-				#:description
 				#:get-selector-for
 				#:make-cstring
 				#:%make-nsstring
-				#:nslog
 				#:ns-make-point
 				#:%null-ptr
 				#:pref




More information about the Mcclim-cvs mailing list