;;;; ch-gtk, wrappers for Gtk+ for Chiken Scheme.
;;;; Copyright (C) 2005 José Pablo Ezequiel "Pupeno" Fernández Silva

;;;; This file is part of ch-gtk.
;;;; Ch-gtk is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.
;;;; Ch-gtk is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
;;;; You should have received a copy of the GNU General Public License along with mr-mysql; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

;; Include gtk/gtk.h.
#>
#include <gtk/gtk.h>
<#

;; This is the new generation FFI (not automatic parsed).

;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Gtk+

;;; Main loop and Events

(define (gtk-init)
  ;; This is a bit ugly, but there is no elegant way to get at argc/argv at the Scheme level and pass pointers to it to foreign code:
  (foreign-code "gtk_init(&C_main_argc, &C_main_argv);"))

;;; GtkWidget

;; typedef struct { ... } GtkWidget;
(define-foreign-type gtk-widget (pointer "GtkWidget"))

;;; GtkWindow

;; typedef struct _GtkWindow GtkWindow;
(define-foreign-type gtk-window (pointer "GtkWindow"))

;; GtkWidget* gtk_window_new(GtkWindowType type);
(define gtk-window-new
  (foreign-lambda gtk-widget "gtk_window_new" integer))

;;; Standard Enumerations

;; typedef enum {
;;   GTK_WINDOW_TOPLEVEL;
;;   GTK_WINDOW_POPUP;
;; }
;;(define-foreign-enum gtk-window-type (enum "GtkWindowType"))
(define gtk-window-toplevel 0)
(define gtk-window-popup 1)

;;;;;;;;
;;;; GDK

;;; Event Structures

;; union GdkEvent {...};
(define-foreign-type gdk-event (c-pointer "GdkEvent"))

;;;;;;;;;;;;
;;;; GObject

;;; Signals

;; #define g_signal_connect(instance, detailed_signal, c_handler, data)
(define g-signal-connect-raw
  (foreign-lambda integer "g_signal_connect" c-pointer c-string c-pointer c-pointer))

(define (g-signal-connect instance signal handler data)
  (g-signal-connect-raw instance 
			signal
			
			data))

;; #define g_signal_connect_swapped(instance, detailed_signal, c_handler, data)
(define g-signal-connect-swapped
  (foreign-lambda integer "g_signal_connect_swapped" c-pointer c-string c-pointer c-pointer))

;;;;;;;;;
;;;; Glib

;;; typedef void* gpointer;
(define-foreign-type gpointer c-pointer)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Here start the ugly 'other' way.

;; Parse declarations and generate Scheme bindings:
;; (compile with "-debug F" to see what it generates)

#>?
/* We just need a declaration, so this is sufficient: */

void gtk_main_quit();
void gtk_container_set_border_width(GtkContainer *, int);
GtkWidget *gtk_button_new_with_label(char *);
void gtk_widget_destroy(GtkWidget *);
void gtk_container_add(GtkContainer *, GtkWidget *);
void gtk_widget_show(GtkWidget *);

/* the "___callback" marker is needed, because "gtk_main()" may
  (and will) call Scheme callbacks. */
___callback void gtk_main();
<#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Definition of the Gtk wrapper ends here, hello world follows ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; New generation hello world.
(gtk-init)
(define window (gtk-window-new gtk-window-toplevel))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Old one:

;; Define a few callback function:

(define-external 
  (hello (gtk-widget widget)
	 (gpointer data))
  void
  (print "Hello, world"))

(define (hello-world widget data)
  (print "Hello, world! From Scheme!"))
  

(define-external 
  (delete_event (gtk-widget widget)
		(gdk-event event)
		(gpointer data) )
  bool
  (print "delete event occurred")
  #t)

(define-external (destroy (gtk-widget widget)
                          (c-pointer data) )
  void
  (gtk_main_quit) )

;; "$#..." with a callback-name returns the function pointer:
    
(g-signal-connect-raw window "delete_event" #$delete_event #f)
(g-signal-connect-raw window "destroy" #$destroy #f)

(gtk_container_set_border_width window 10)
    
(define button (gtk_button_new_with_label "Hello World"))
    
(g-signal-connect-raw button "clicked" #$hello #f)

;; Here we use "foreign-value" to get the function pointer.
;; "#$gtk_widget_destroy" wouldn't work: the function is not
;; a callback:

(g-signal-connect-swapped button "clicked" 
  (foreign-value "gtk_widget_destroy" c-pointer) window)

(gtk_container_add window button)
(gtk_widget_show button)
(gtk_widget_show window)
(gtk_main)