#!/usr/bin/perl

# This source files is
# Copyright (C) 2002, Göran Thyni and are
# licensed for use under the same terms as Perl itself.

use Inline C => Config =>
  ENABLE => AUTOWRAP,
  GLOBAL_LOAD => 1,
  NAME => 'Gtk2',
  LIBS => `pkg-config gtk+-2.0 --libs`,
  OPTIMIZE => '-g',
  INC => `pkg-config gtk+-2.0 --cflags`;
use Inline C;


my $nargs = scalar(@ARGV);
my $args = [ ARGV];
#gtkperl_init($nargs,$args);
gtkperl_init();
my $window = gtkperl_window_new(0);
my $button = gtkperl_button_new();
my $label = gtkperl_label_new("Hello world!");
gtkperl_container_add($button,$label);
gtkperl_container_add($window,$button);
gtkperl_window_set_title($window,"Hello");
gtkperl_container_set_border_width($button,10);
print "Add delete_event to $window\n";
gtkperl_signal_connect($window,"delete_event", \&delete_event_cb, undef);
print "Add clicked to $button with $label\n";
gtkperl_signal_connect($button,"clicked", \&button_click_cb, $label);
#gtkperl_signal_connect($button,"clicked", \&button_click_cb, undef);
gtkperl_widget_show_all($window);
print "Main in ", __PACKAGE__, "\n" ;
gtkperl_main();
exit 0;

sub delete_event_cb
  {
    gtkperl_main_quit();
    return 0;
  }

sub button_click_cb
  {
    #my ($widget, $label) = @_;
    my ($mylabel) = @_;
    #$mylabel = $label;
    #print "$widget, $mylabel in ", __PACKAGE__, "\n" ;
    print "xlabel: $mylabel in ", __PACKAGE__, "\n";
    my $text = gtkperl_label_get($mylabel);
    print "$mylabel is $text\n";
    my $tmp = reverse $text;
    gtkperl_label_set($mylabel,$tmp);
    print "$mylabel became $tmp\n";
  }

__DATA__
__C__

#include <gtk/gtk.h>

void gtkperl_init()
{
  /* does not return ARGV, FIXME */
  int n;
  char** a;
  n = 1;
  a = (char**) malloc(2 * sizeof(char*));
  a[0] = "2.pl";
  a[1] = NULL;
  gtk_init(&n, &a);
}

void gtkperl_main() { gtk_main(); }
void gtkperl_main_quit() { gtk_main_quit(); }

/* SIGNALS */

typedef struct _perlClosure {
    GClosure closure;
    SV* callback;
    SV* extra_args; /* tuple of extra args to pass to callback */
    SV* swap_data; /* other object for gtk_signal_connect_object */
} perlClosure;

static void perl_closure_invalidate(gpointer data, GClosure *closure)
{
    perlClosure *pc = (perlClosure *)closure;
    fprintf(stderr,"Invalidating closure %lx\n", pc);
    SvREFCNT_dec(pc->callback);
    SvREFCNT_dec(pc->extra_args);
    SvREFCNT_dec(pc->swap_data);
    pc->callback = NULL;
    pc->extra_args = NULL;
    pc->swap_data = NULL;
}

static void
perl_closure_marshal(GClosure *closure,
		     GValue *return_value,
		     guint n_param_values,
		     const GValue *param_values,
		     gpointer invocation_hint,
		     gpointer marshal_data)
{
    perlClosure *pc = (perlClosure *)closure;
    guint i;
    fprintf(stderr,"Marshalling: func: %lx (refcnt: %d) data: %lx (refcnt: %d)\n", 
	    pc->callback, pc->callback->sv_refcnt,
	    pc->extra_args, pc->extra_args ? pc->extra_args->sv_refcnt : 0);
    // g_assert(pc->extra_args);
    if (pc->extra_args)
      {
	g_assert(!G_IS_OBJECT(pc->extra_args));
      }
    {
	dSP;
	ENTER;
	SAVETMPS;
	PUSHMARK(SP);
	XPUSHs(sv_2mortal(pc->extra_args ? pc->extra_args : &PL_sv_undef));
	PUTBACK ;
	perl_call_sv(pc->callback, 0);
	SPAGAIN;
	PUTBACK;
	FREETMPS;
	LEAVE;
    }
    // fprintf(stderr,"Marshalling2...\n");
}

static GClosure* perl_closure_new(SV *callback, SV *extra_args, SV *swap_data)
{
  perlClosure *closure;
  g_return_val_if_fail(callback != NULL, NULL);
  closure = (perlClosure*) g_closure_new_simple(sizeof(perlClosure), NULL);
  g_closure_add_invalidate_notifier((GClosure*) closure, NULL, perl_closure_invalidate);
  g_closure_set_marshal((GClosure*) closure, perl_closure_marshal);
  SvREFCNT_inc(callback);
  closure->callback = callback;
  closure->extra_args = NULL;
  if (extra_args && extra_args != &PL_sv_undef) {
    SvREFCNT_inc(extra_args);
    closure->extra_args = extra_args;
  }
  closure->swap_data = NULL;
  if (swap_data && swap_data != &PL_sv_undef) {
    SvREFCNT_inc(swap_data);
    closure->swap_data = swap_data;
    closure->closure.derivative_flag = TRUE;
  }
  return (GClosure*) closure;
}

long gtkperl_signal_connect(SV* objref, char* name, SV* callback, SV* data)
  {
    SV* swap_data = NULL;
    GClosure* closure = NULL;
    SvREFCNT_inc(objref);
    SvREFCNT_inc(callback);
    SvREFCNT_inc(data);
    closure = perl_closure_new(callback, data, swap_data);
    return g_signal_connect_closure(SvIV((SV*)SvRV(objref)), name, closure, FALSE);
  }

/* CONTAINER */

  void gtkperl_container_add(SV *container, SV *widget)
  {
    GtkContainer* c =  (GtkContainer*) SvIV(SvRV(container));
    GtkWidget* w =  (GtkWidget*) SvIV(SvRV(widget));
    gtk_container_add(c,w);
  }

void gtkperl_container_set_border_width(SV* button, int width)
  {
    GtkButton* b =  (GtkButton*) SvIV(SvRV(button));
    gtk_container_set_border_width(b,width);
  }

/* WIDGET */

void gtkperl_widget_show(SV* widget)
  {
    GtkWidget* w =  (GtkWidget*) SvIV(SvRV(widget));
    gtk_widget_show(w);
  }

void gtkperl_widget_show_all(SV* widget)
  {
    GtkWidget* w =  (GtkWidget*) SvIV(SvRV(widget));
    gtk_widget_show_all(w);
  }

/* WINDOW */

SV* gtkperl_window_new(int type)
  {
    SV *obj_ref, *obj;
    GtkWindowType t = type;
    obj_ref = newSViv(0);
    obj = newSVrv(obj_ref, "GtkWindow");
    {
      GtkWindow* w = gtk_window_new(t);
      sv_setiv(obj, (IV)w);
      SvREADONLY_on(obj);
    }
    return obj_ref;
  }

void gtkperl_window_set_title(SV* window, char* title)
  {
    GtkWindow* w =  (GtkWindow*) SvIV(SvRV(window));
    gtk_window_set_title(w,title);
  }

/* BUTTON */

SV* gtkperl_button_new()
  {
    SV *obj_ref, *obj;
    obj_ref = newSViv(0);
    obj = newSVrv(obj_ref, "GtkButton");
    {
      GtkButton* b = gtk_button_new();
      sv_setiv(obj, (IV)b);
      SvREADONLY_on(obj);
    }
    return obj_ref;
  }


/* LABEL */

SV* gtkperl_label_new(char* text)
  {
    SV *obj_ref, *obj;
    obj_ref = newSViv(0);
    obj = newSVrv(obj_ref, "GtkLabel");
    {
      GtkLabel* w = gtk_label_new(text);
      sv_setiv(obj, (IV)w);
      SvREADONLY_on(obj);
    }
    return obj_ref;
  }

char* gtkperl_label_get(SV* label)
  {
    gchar* text;
    GtkLabel* l =  (GtkLabel*) SvIV(SvRV(label));
    gtk_label_get(l,&text);
    return text;
  }

void gtkperl_label_set(SV* label, char* text)
  {
    GtkLabel* l =  (GtkLabel*) SvIV(SvRV(label));
    gtk_label_set(l,text);
  }