[Openmcl-devel] wrapping foreign objects in lisp classes

[Cyrus Harmon]

Thanks for the tip. I had the syntax for the (defmethod (setf foo) 
(...)) call wrong. Fixing this makes the setf stuff a bit cleaner 
although the :initargs still don't work right.


(defmacro def-foreign-slot (lclass lslot pslot ffield)
   `(progn
      (defmethod ,lslot ((obj ,lclass))
        (pref (,pslot obj) ,ffield))
      (defmethod (setf ,lslot) (value (obj ,lclass))
        (setf (pref (,pslot obj) ,ffield) value))
      ))

(defclass vimage-buffer-8888 ()
   ((mac-vimage-buffer :accessor mac-vimage-buffer :initform 
(make-record :v<I>mage_<B>uffer))
    (height :accessor height :initarg :height)
    (width :accessor width :initarg :width)
    (rowbytes :accessor rowbytes)
    (data :accessor data)))

(def-foreign-slot vimage-buffer-8888 height mac-vimage-buffer 
:v<I>mage_<B>uffer.height)
(def-foreign-slot vimage-buffer-8888 width mac-vimage-buffer 
:v<I>mage_<B>uffer.width)
(def-foreign-slot vimage-buffer-8888 data mac-vimage-buffer 
:v<I>mage_<B>uffer.data)
(def-foreign-slot vimage-buffer-8888 rowbytes mac-vimage-buffer 
:v<I>mage_<B>uffer.row<B>ytes)



On Aug 16, 2004, at 4:29 PM, Gary Byers wrote:
> (defmethod (setf point-x) (new (p point))
>   (let* ((real-point (real-point p)))
>     (setf (pref real-point :point.x) new)))