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)))) ,@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