klisp

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

ffi-gtk-callback.k (2211B)

      1 ;;
      2 ;; Dynamic FFI example.
      3 ;;
      4 ;; Inspired by example gtk.lua from Lua Alien FFI library
      5 ;; (the original is only 11 lines long, though...)
      6 ;;
      7 
      8 ($define! gtk (ffi-load-library "libgtk-x11-2.0.so.0"))
      9 
     10 ;; constants for c types
     11 ($define! i "sint")
     12 ($define! p "pointer")
     13 ($define! s "string")
     14 ($define! v "void")
     15 ($define! u32 "uint32")
     16 
     17 ;; helpers for applicative and callback creation
     18 ($define! make
     19   ($lambda (rtype name . atypes)
     20     (ffi-make-applicative gtk name
     21       (ffi-make-call-interface "FFI_DEFAULT_ABI" rtype atypes))))
     22 
     23 ($define! make-callback
     24   ($lambda (rtype app . atypes)
     25     (ffi-make-callback 
     26      app (ffi-make-call-interface "FFI_DEFAULT_ABI" rtype atypes))))
     27 
     28 
     29 ;; gtk bindings
     30 ($define! gtk-init (make v "gtk_init" p p))
     31 ($define! gtk-main (make v "gtk_main"))
     32 ($define! gtk-main-quit (make v "gtk_main_quit"))
     33 
     34 ($define! GTK_WINDOW_TOPLEVEL 0) ;; these two are for the window type enum
     35 ($define! GTK_WINDOW_POPUP 1)
     36 ($define! gtk-window-new (make p "gtk_window_new" i))
     37 ($define! gtk-window-set-title (make v "gtk_window_set_title" p s))
     38 ($define! gtk-widget-show (make v "gtk_widget_show" p))
     39 
     40 ($define! g-signal-connect-object (make u32 "g_signal_connect_object" p s p p i))
     41 ($define! G_CONNECT_AFTER 1) ;; these two are for the connect flag type enum
     42 ($define! G_CONNECT_SWAPPED 2)
     43 ($define! g-connect ($lambda (obj sig cb data) 
     44                       (g-signal-connect-object obj sig cb data G_CONNECT_AFTER)))  
     45 
     46 ;; as per GTK the callback returns void and takes two pointer params: 
     47 ;; the object and a data pointer (both are ignored in this case)
     48 ($define! my-destroy-handler 
     49   (make-callback v 
     50                  ($lambda (obj data)
     51                    (display "destroying...")
     52                    (gtk-main-quit))
     53                  p p))
     54 
     55 (gtk-init () ())
     56 ($define! window (gtk-window-new GTK_WINDOW_TOPLEVEL))
     57 (gtk-window-set-title window "Callback Test")
     58 ;; This will make the "x" in the window show a "destroying..." msg
     59 ;; and exit the gtk loop
     60 (g-connect window "destroy" my-destroy-handler ())
     61 (gtk-widget-show window)
     62 (display "Running main...")
     63 (gtk-main)
     64 ;; if we reached here, the callback was called and the main
     65 ;; gtk loop ended, so we are done!
     66 (display "Done\n")
     67