an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

commit aae7efec701a76e62417f75db95c0aa5c66055ed
parent dbddf0a813cbd22e258b9b79b148f2cf1dbf7e19
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Thu, 22 Mar 2012 02:05:33 -0300

Added an ffi gtk callback example.

Asrc/examples/ffi-gtk-callback.k | 67+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 67 insertions(+), 0 deletions(-)

diff --git a/src/examples/ffi-gtk-callback.k b/src/examples/ffi-gtk-callback.k @@ -0,0 +1,67 @@ +;; +;; Dynamic FFI example. +;; +;; Inspired by example gtk.lua from Lua Alien FFI library +;; (the original is only 11 lines long, though...) +;; + +($define! gtk (ffi-load-library "libgtk-x11-2.0.so.0")) + +;; constants for c types +($define! i "sint") +($define! p "pointer") +($define! s "string") +($define! v "void") +($define! u32 "uint32") + +;; helpers for applicative and callback creation +($define! make + ($lambda (rtype name . atypes) + (ffi-make-applicative gtk name + (ffi-make-call-interface "FFI_DEFAULT_ABI" rtype atypes)))) + +($define! make-callback + ($lambda (rtype app . atypes) + (ffi-make-callback + app (ffi-make-call-interface "FFI_DEFAULT_ABI" rtype atypes)))) + + +;; gtk bindings +($define! gtk-init (make v "gtk_init" p p)) +($define! gtk-main (make v "gtk_main")) +($define! gtk-main-quit (make v "gtk_main_quit")) + +($define! GTK_WINDOW_TOPLEVEL 0) ;; these two are for the window type enum +($define! GTK_WINDOW_POPUP 1) +($define! gtk-window-new (make p "gtk_window_new" i)) +($define! gtk-window-set-title (make v "gtk_window_set_title" p s)) +($define! gtk-widget-show (make v "gtk_widget_show" p)) + +($define! g-signal-connect-object (make u32 "g_signal_connect_object" p s p p i)) +($define! G_CONNECT_AFTER 1) ;; these two are for the connect flag type enum +($define! G_CONNECT_SWAPPED 2) +($define! g-connect ($lambda (obj sig cb data) + (g-signal-connect-object obj sig cb data G_CONNECT_AFTER))) + +;; as per GTK the callback returns void and takes two pointer params: +;; the object and a data pointer (both are ignored in this case) +($define! my-destroy-handler + (make-callback v + ($lambda (obj data) + (display "destroying...") + (gtk-main-quit)) + p p)) + +(gtk-init () ()) +($define! window (gtk-window-new GTK_WINDOW_TOPLEVEL)) +(gtk-window-set-title window "Callback Test") +;; This will make the "x" in the window show a "destroying..." msg +;; and exit the gtk loop +(g-connect window "destroy" my-destroy-handler ()) +(gtk-widget-show window) +(display "Running main...") +(gtk-main) +;; if we reached here, the callback was called and the main +;; gtk loop ended, so we are done! +(display "Done\n") +