GTKでFFIをテスト

FFIのテストのためにGTKを使ってみました。世の中こんな便利になっていたとは :p

テストプログラムはLinux用で32bit(0.9.6-update2)と64bit(trunk)の両方で動作を確認しています。リストをREPLにコピペすれば動きますよ :)

#!r6rs
(import (rnrs) (ffi) (only (core) format load-shared-object))

; minimal bindings for GTK hello world

(define libgtk-name "libgtk-x11-2.0.so.0")
(define libgtk (load-shared-object libgtk-name))

(define-syntax define-function
  (syntax-rules ()
    ((_ ret name args)
     (define name (c-function libgtk libgtk-name ret name args)))))

(define-function void  gtk_init ([int] (*[char*])))
(define-function void* gtk_window_new (int))
(define-function void  gtk_window_set_title (void* char*))
(define-function void  gtk_window_resize (void* int int))
(define-function void* gtk_button_new_with_label (char*))
(define-function void  gtk_widget_show (void*))
(define-function void  gtk_widget_destroy (void*))
(define-function void  gtk_main ())
(define-function void  gtk_main_quit ())
(define-function void  gtk_container_add (void* void*))
(define-function void  gtk_container_set_border_width (void* int))
(define-function int   g_signal_connect_data (void* char* [c-callback int (void* void* void*)] void* void* int))
(define-function int   g_signal_connect_object (void* char* [c-callback int (void*)] void* int))

(define GTK_WINDOW_TOPLEVEL 0)
(define G_CONNECT_SWAPPED   2)

(define g_signal_connect
  (lambda (instance detailed_signal c_handler data)
    (g_signal_connect_data instance detailed_signal c_handler data 0 0)))

(define g_signal_connect_swapped
  (lambda (instance detailed_signal c_handler object)
    (g_signal_connect_object instance detailed_signal c_handler object G_CONNECT_SWAPPED)))

; GTK hello world

(gtk_init (vector (length (command-line))) (apply vector (command-line)))
(let ((window (gtk_window_new GTK_WINDOW_TOPLEVEL))
      (button (gtk_button_new_with_label "Hello World"))
      (destroy
       (lambda x
         (format #t "[destory ~s]~%" x)
         (gtk_main_quit)))
      (clicked
       (lambda x
         (format #t "[clicked ~s]~%" x))))
  (gtk_container_set_border_width window 10)
  (gtk_window_set_title window "Hello World")
  (gtk_window_resize window 256 128)
  (g_signal_connect window "destroy" destroy 0)
  (g_signal_connect button "clicked" clicked 0)
  (g_signal_connect_swapped button "clicked" gtk_widget_destroy window)
  (gtk_container_add window button)
  (gtk_widget_show button)
  (gtk_widget_show window)
  (gtk_main))