1#| -*-Scheme-*- 2 3This is Havoc Pennington's Hello World example from GGAD, in the raw 4FFI. Note that no arrangements have been made to de-register the 5callbacks. |# 6 7(declare (usual-integrations)) 8 9(C-include "prhello") 10 11(define (hello) 12 (C-call "gtk_init" 0 null-alien) 13 (let ((window (let ((alien (make-alien '|GtkWidget|))) 14 (C-call "gtk_window_new" alien 15 (C-enum "GTK_WINDOW_TOPLEVEL")) 16 (if (alien-null? alien) (error "Could not create window.")) 17 alien)) 18 (button (let ((alien (make-alien '|GtkWidget|))) 19 (C-call "gtk_button_new" alien) 20 (if (alien-null? alien) (error "Could not create button.")) 21 alien)) 22 (label (let ((alien (make-alien '|GtkWidget|))) 23 (C-call "gtk_label_new" alien "Hello, World!") 24 (if (alien-null? alien) (error "Could not create label.")) 25 alien))) 26 (C-call "gtk_container_add" button label) 27 (C-call "gtk_container_add" window button) 28 (C-call "gtk_window_set_title" window "Hello") 29 (C-call "gtk_container_set_border_width" button 10) 30 (let ((counter 0)) 31 (C-call "g_signal_connect" window "delete_event" 32 (C-callback "delete_event") ;trampoline 33 (C-callback ;callback ID 34 (lambda (w e) 35 (outf-error ";Delete me "(- 2 counter)" times.\n") 36 (set! counter (1+ counter)) 37 ;; Three or more is the charm. 38 (if (> counter 2) 39 (begin 40 (C-call "gtk_main_quit") 41 0) 42 1)))) 43 (C-call "g_signal_connect" button "clicked" 44 (C-callback "clicked") ;trampoline 45 (C-callback ;callback ID 46 (lambda (w) 47 (let ((gstring (make-alien '(* |gchar|)))) 48 (C-call "gtk_label_get_text" gstring label) 49 (let ((text (c-peek-cstring gstring))) 50 (C-call "gtk_label_set_text" label 51 (list->string (reverse! (string->list text)))))) 52 unspecific)))) 53 (C-call "gtk_widget_show_all" window) 54 (C-call "gtk_main") 55 window))