Jeez, you guys are useless. I should have posted the example in
studlyCaps, I might have gotten a response. :)
OK, putting UFFI aside a moment, here is an Allegro port
(ffi-to-uffi-type does the obvious):
#+clisp
(defun gtk-object-set-property (obj property val-type val)
(let ((varargs-def
`(c-struct list
(value ,val-type)
(end c-pointer))))
(with-c-var (vec varargs-def (list val nil))
(g-object-set-valist obj property (c-var-address (slot vec
'value))))))
#+allegro
(defun gtk-object-set-property (obj property val-type val)
(let ((varargs-def (let ((type-name (intern (string-upcase
(format nil
"gtk-osp-list-~a" val-type)))))
(ff:ensure-foreign-type
:name type-name
:definition `(:struct
(value (ffi-to-uffi-type val-type))
(end (ffi-to-uffi-type c-pointer))))
type-name)))
(let ((vec (ff:allocate-fobject varargs-def :c)))
(setf (ff:fslot-value-typed varargs-def :foreign vec 'value) val)
(setf (ff:fslot-value-typed varargs-def :foreign vec 'end) 0)
(prog1
(g-object-set-valist obj property vec)
(ff:free-fobject vec)))))
It is really brilliant. I am quite proud of it. It could not be better.
None of you could do any better. (desperately trying to stir the savages
to rip it apart and fix it.)
:)
kenny
--
Cells? Cello? Celtik?: http://www.common-lisp.net/project/cells/
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film
Kenny Tilton wrote:
> #+allegro
> (defun gtk-object-set-property (obj property val-type val)
> (let ((varargs-def (let ((type-name (intern (string-upcase
> (format nil
> "gtk-osp-list-~a" val-type)))))
> (ff:ensure-foreign-type
> :name type-name
> :definition `(:struct
> (value (ffi-to-uffi-type val-type))
> (end (ffi-to-uffi-type c-pointer))))
> type-name)))
>
> (let ((vec (ff:allocate-fobject varargs-def :c)))
> (setf (ff:fslot-value-typed varargs-def :foreign vec 'value) val)
> (setf (ff:fslot-value-typed varargs-def :foreign vec 'end) 0)
> (prog1
> (g-object-set-valist obj property vec)
> (ff:free-fobject vec)))))
>
> It is really brilliant. I am quite proud of it. It could not be better.
> None of you could do any better. (desperately trying to stir the savages
> to rip it apart and fix it.)
Don't try so hard. How about just predefining
all the struct types up front (with some fancy macro
if you like to save typing) and map them to the properties?
This interning and ensuring thing seems like a killer.
Then do something like:
(defun gtk-object-set-property (obj property val)
(let* ((fftype (find-gtk-fftype property))
(vec (ff:allocate-fobject fftype :c)))
(setf (ff:fslot-value-typed fftype :foreign vec 'value) val)
(setf (ff:fslot-value-typed fftype :foreign vec 'end) 0)
(prog1
(g-object-set-valist obj property vec)
(ff:free-fobject vec))))
Wade
Wade Humeniuk wrote:
> Kenny Tilton wrote:
>
>> #+allegro
>> (defun gtk-object-set-property (obj property val-type val)
>> (let ((varargs-def (let ((type-name (intern (string-upcase
>> (format nil
>> "gtk-osp-list-~a" val-type)))))
>> (ff:ensure-foreign-type
>> :name type-name
>> :definition `(:struct
>> (value (ffi-to-uffi-type val-type))
>> (end (ffi-to-uffi-type
>> c-pointer))))
>> type-name)))
>>
>> (let ((vec (ff:allocate-fobject varargs-def :c)))
>> (setf (ff:fslot-value-typed varargs-def :foreign vec 'value) val)
>> (setf (ff:fslot-value-typed varargs-def :foreign vec 'end) 0)
>> (prog1
>> (g-object-set-valist obj property vec)
>> (ff:free-fobject vec)))))
>>
>> It is really brilliant. I am quite proud of it. It could not be
>> better. None of you could do any better. (desperately trying to stir
>> the savages to rip it apart and fix it.)
>
>
> Don't try so hard. How about just predefining
> all the struct types up front (with some fancy macro
> if you like to save typing) and map them to the properties?
Yeah, I considered that, and Vasilis has sent along a rewrite of that
function which does the same, so I will look at that since he is clearly
on top of this FFI crud. Still...
> This interning and ensuring thing seems like a killer.
Well, the ensuring was part of the API, and documented as the functional
equivalent of the def. ie, pretty close to the, if you will, anonymous
aggregates of CLisp FFI, but not anonymous hence the interning of
something likely not to collide.
My philosophy is that I can run but not hide. So even if I tried to
cheat by hardcoding all the possibles, something else would come along
and I would end up chasing that down, and all the while the code is
getting hackier and hackier... or I can drop by c.l.l. and have youse
guys figure it out for me! There's a no-brainer. :)
>
> Then do something like:
>
> (defun gtk-object-set-property (obj property val)
> (let* ((fftype (find-gtk-fftype property))
> (vec (ff:allocate-fobject fftype :c)))
> (setf (ff:fslot-value-typed fftype :foreign vec 'value) val)
> (setf (ff:fslot-value-typed fftype :foreign vec 'end) 0)
> (prog1
> (g-object-set-valist obj property vec)
> (ff:free-fobject vec))))
Yep, but later on there was a truly massive WITH-C-VAR, and part of me
was thinking maybe I could eventually come up with a contrib for UFFI to
include a new "anonymous type" construct, so I wanted to stay as close
to with-c-var as possible.
Thx for the input.
kenny
--
Cells? Cello? Celtik?: http://www.common-lisp.net/project/cells/
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film
Kenny Tilton wrote:
>
>
> My philosophy is that I can run but not hide. So even if I tried to
> cheat by hardcoding all the possibles, something else would come along
> and I would end up chasing that down, and all the while the code is
> getting hackier and hackier... or I can drop by c.l.l. and have youse
> guys figure it out for me! There's a no-brainer. :)
>
Then:
(defvar *gtk-val-types* (make-hash-table))
(defun find-gtk-fftype (val-type)
(gethash val-type *gtk-val-types*
(setf (gethash val-type *gtk-val-types*)
(let ((newfftype (intern (format nil "~a-~a" 'gtk-osp-list val-type))))
(ff:ensure-foreign-type
:name newfftype
:definition `(:struct
(value (ffi-to-uffi-type val-type))
(end (ffi-to-uffi-type c-pointer))))
newfftype))))
(defun gtk-object-set-property (obj property val-type val)
(let* ((fftype (find-gtk-fftype val-type))
(vec (ff:allocate-fobject fftype :c)))
(setf (ff:fslot-value-typed fftype :foreign vec 'value) val)
(setf (ff:fslot-value-typed fftype :foreign vec 'end) 0)
(prog1
(g-object-set-valist obj property vec)
(ff:free-fobject vec))))
Wade
Wade Humeniuk wrote:
> Kenneth Tilton wrote:
>
>>
>> Don't encourage me!! <g>
>>
>
> Here is some more temptation, hehe
>
> With the LW FLI you can do this
uh-oh, careful, you may get volunteered for the next phase. I am totally
punking out on uffi-izing cells-gtk and just trying to get it to run
against AllegroCL as a stepping-stone. Success there would give me some
encouragement that we can get to UFFI and secure the whole enchilada.
(ie, Watch for outraged whining in this space about how UFFI could never
possibly handle cells-gtk. :)
As for your continued fine efforts, let us save them for battle next.
Vasilis has taken pity on my weak FFI skills and switched to a different
GLib (?) entry point:
(defun gtk-object-set-property (obj property val-type val)
(with-c-var (value '(c-struct list (type c-pointer) (val c-pointer))
(list
nil nil))
(let ((str-ptr (and (eql val-type 'c-string) (to-gtk-string val))))
(g-value-init (c-var-address value) (value-type-as-int val-type))
(funcall (value-set-function val-type)
(c-var-address value)
(or str-ptr val))
====> (g-object-set-property obj property (c-var-address value))
(g-value-unset (c-var-address value))
(when str-ptr (g-free str-ptr)))))
I have a compile under ACL (damn the warnings. full speed ahead) and
will soon be trying to run this bad boy.
Courage.
kenny
--
Cells? Cello? Celtik?: http://www.common-lisp.net/project/cells/
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film
Kenny Tilton wrote:
>
>
> Wade Humeniuk wrote:
>
>> Kenneth Tilton wrote:
>>
>>>
>>> Don't encourage me!! <g>
>>>
>>
>> Here is some more temptation, hehe
>>
>> With the LW FLI you can do this
>
>
> uh-oh, careful, you may get volunteered for the next phase. I am totally
> punking out on uffi-izing cells-gtk and just trying to get it to run
> against AllegroCL as a stepping-stone. Success there would give me some
> encouragement that we can get to UFFI and secure the whole enchilada.
> (ie, Watch for outraged whining in this space about how UFFI could never
> possibly handle cells-gtk. :)
>
> As for your continued fine efforts, let us save them for battle next.
> Vasilis has taken pity on my weak FFI skills and switched to a different
> GLib (?) entry point:
Ah, but we still have WITH-C-VAR on an anonymous struct type, so:
(defmacro with-c-var ((name type &optional initform) &body body)
(if (eql 'c-struct (caadr type))
(destructuring-bind (quote (c-struct type-name &rest
slot-defs)) type
(declare (ignore quote c-struct))
;;(print (list type-name slot-defs))
(setq type-name (copy-symbol 'type))
`(progn
(eval-when (compile load eval)
(ff:ensure-foreign-type
:name ',type-name
:definition '(:struct
,@(mapcar (lambda (slot-def)
(destructuring-bind (name
type) slot-def
`(,name
,(ffi-to-native-type type))))
slot-defs))))
(ff:with-stack-fobject (,name ',type-name)
(loop for init-val in ,initform
for slot-def in ',slot-defs
do (setf (ff:fslot-value-typed ',type-name
:foreign ,name (car slot-def))
init-val))
,@body)))
(let ((native-type (ffi-to-native-type type)))
`(ff:with-stack-fobject (,name ,native-type)
,(when initform
`(setf (ff:fslot-value-typed ,native-type :foreign
',name) ,initform))
,@body))))
Untested. :)
kt
--
Cells? Cello? Celtik?: http://www.common-lisp.net/project/cells/
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film