Hello World - FFI 0.2
Description: FFI 0.2

Next: GNU Free Documentation License, Previous: Compiling and Linking, Up: Top

## 7 Hello World

This node includes the C declarations and Scheme code required to implement Havoc Pennington's Hello World example from GGAD. For an extra, Schemely treat, its `delete_event` callback is a Scheme procedure closed over a binding of `counter` that is used to implement some impertinent behavior.

         #| -*-Scheme-*-

         This is Havoc Pennington's Hello World example from GGAD, in the raw
         FFI.  Note that no arrangements have been made to de-register the
         callbacks. |#

         (declare (usual-integrations))

         (C-include "prhello")

         (define (hello)
           (C-call "gtk_init" 0 null-alien)
           (let ((window (let ((alien (make-alien '|GtkWidget|)))
         		  (C-call "gtk_window_new" alien
         			  (C-enum "GTK_WINDOW_TOPLEVEL"))
         		  (if (alien-null? alien) (error "Could not create window."))
         		  alien))
         	(button (let ((alien (make-alien '|GtkWidget|)))
         		  (C-call "gtk_button_new" alien)
         		  (if (alien-null? alien) (error "Could not create button."))
         		  alien))
         	(label (let ((alien (make-alien '|GtkWidget|)))
         		 (C-call "gtk_label_new" alien "Hello, World!")
         		 (if (alien-null? alien) (error "Could not create label."))
         		 alien)))
             (C-call "gtk_container_add" button label)
             (C-call "gtk_container_add" window button)
             (C-call "gtk_window_set_title" window "Hello")
             (C-call "gtk_container_set_border_width" button 10)
             (let ((counter 0))
               (C-call "g_signal_connect" window "delete_event"
         	      (C-callback "delete_event")	;trampoline
         	      (C-callback			;callback ID
         	       (lambda (w e)
         		 (outf-error ";Delete me "(- 2 counter)" times.\n")
         		 (set! counter (1+ counter))
         		 ;; Three or more is the charm.
         		 (if (> counter 2)
         		     (begin
         		       (C-call "gtk_main_quit")
         		       0)
         		     1))))
               (C-call "g_signal_connect" button "clicked"
         	      (C-callback "clicked")	;trampoline
         	      (C-callback			;callback ID
         	       (lambda (w)
         		 (let ((gstring (make-alien '(* |gchar|))))
         		   (C-call "gtk_label_get_text" gstring label)
         		   (let ((text (c-peek-cstring gstring)))
         		     (C-call "gtk_label_set_text" label
         			     (list->string (reverse! (string->list text))))))
         		 unspecific))))
             (C-call "gtk_widget_show_all" window)
             (C-call "gtk_main")
             window))

Here are the C declarations.

         #| -*-Scheme-*-

         C declarations for prhello.scm. |#

         (typedef gint int)
         (typedef guint uint)
         (typedef gchar char)
         (typedef gboolean gint)
         (typedef gpointer (* mumble))

         (extern void
         	gtk_init
         	(argc (* int))
         	(argv (* (* (* char)))))

         (extern (* GtkWidget)
         	gtk_window_new
         	(type GtkWindowType))

         (typedef GtkWindowType
         	 (enum
         	  (GTK_WINDOW_TOPLEVEL)
         	  (GTK_WINDOW_POPUP)))

         (extern (* GtkWidget)
         	gtk_button_new)

         (extern (* GtkWidget)
         	gtk_label_new
         	(str (* (const char))))

         (extern void
         	gtk_container_add
         	(container (* GtkContainer))
         	(widget    (* GtkWidget)))

         (extern void
         	gtk_window_set_title
         	(window (* GtkWindow))
         	(title  (* (const gchar))))

         (extern void
         	gtk_container_set_border_width
         	(container (* GtkContainer))
         	(border_width guint))

         (extern void
         	gtk_widget_show_all
         	(widget (* GtkWidget)))

         (extern void
         	g_signal_connect
         	(object (* GtkObject))
         	(name (* gchar))
         	(CALLBACK GtkSignalFunc)
         	(ID gpointer))

         (typedef GtkSignalFunc (* mumble))

         (callback gboolean
         	  delete_event
         	  (window (* GtkWidget))
         	  (event (* GdkEventAny))
         	  (ID gpointer))

         (callback void
         	  clicked
         	  (widget (* GtkWidget))
         	  (ID gpointer))

         (extern void
         	gtk_widget_destroy
         	(widget (* GtkWidget)))

         (extern (* (const gchar))
         	gtk_label_get_text
         	(label (* GtkLabel)))

         (extern void
         	gtk_label_set_text
         	(label (* GtkLabel))
         	(str (* (const char))))

         (extern void gtk_main)
         (extern void gtk_main_quit)