[cells-cvs] CVS update: cell-cultures/ffi-extender/arrays.lisp cell-cultures/ffi-extender/callbacks.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cell-cultures/ffi-extender
In directory common-lisp.net:/tmp/cvs-serv19757/ffi-extender

Modified Files:
	arrays.lisp callbacks.lisp 
Log Message:
Patches to support cells-gtk; ongoing glut refinements cello osx port
Date: Wed Nov 17 13:31:51 2004
Author: ktilton

Index: cell-cultures/ffi-extender/arrays.lisp
diff -u cell-cultures/ffi-extender/arrays.lisp:1.2 cell-cultures/ffi-extender/arrays.lisp:1.3
--- cell-cultures/ffi-extender/arrays.lisp:1.2	Tue Oct 19 05:47:37 2004
+++ cell-cultures/ffi-extender/arrays.lisp	Wed Nov 17 13:31:51 2004
@@ -175,6 +175,12 @@
 (defun (setf eltf) (value v n)
   (setf (ff-elt v :float n) (coerce value 'float)))
 
+(defun elt$ (v n)
+  (ff-elt v :cstring n))
+
+(defun (setf elt$) (value v n)
+  (setf (ff-elt v :cstring n) value))
+
 (defun eltd (v n)
   (ff-elt v :double n))
 


Index: cell-cultures/ffi-extender/callbacks.lisp
diff -u cell-cultures/ffi-extender/callbacks.lisp:1.1 cell-cultures/ffi-extender/callbacks.lisp:1.2
--- cell-cultures/ffi-extender/callbacks.lisp:1.1	Sat Jun 26 20:38:42 2004
+++ cell-cultures/ffi-extender/callbacks.lisp	Wed Nov 17 13:31:51 2004
@@ -55,26 +55,6 @@
                               (:stdcall :stdcall))))
      , at body))
 
-#+dave
-(fli:define-foreign-callable 
-    (wndproc :result-type :long :calling-convention :stdcall)
-    ((hwnd hwnd) (msg (:unsigned :long)) 
-     (wparam (:unsigned :long)) (lparam (:unsigned :long)))
-  (cond 
-   ((= msg wm-paint) (wndproc-paint hwnd msg wparam lparam))
-   #+console ((= msg wm-destroy) (postquitmessage 0) 0)
-   (t (defwindowproc hwnd msg wparam lparam))))
-
-#+dave
-(defun register-class ()
-  (fli:with-foreign-string (cn-p ec bc :external-format *external-format*)
-      *class-name*
-    ;; Below - use with-dynamic... for automatic freeing. Make some pointers.
-    (let ((wc-p (fli:allocate-foreign-object :type 'wndclass))
-          (wp-p (fli:make-pointer :symbol-name "wndproc")))
-      ...
-      (setf (fli:foreign-slot-value wc-p 'lpfnwndproc)
-            (fli:pointer-address wp-p)))))
       
 #+test ;; lw-sample
 (fli:define-foreign-callable