#!/usr/bin/perl -w # GTK - The GIMP Toolkit # Copyright (C) 1995-1997 Peter Mattis, Spencer Kimball and Josh MacDonald # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library 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 # Library General Public License for more details. # # You should have received a copy of the GNU Library General Public # License along with this library; if not, write to the # Free Software Foundation, Inc., 59 Temple Place - Suite 330, # Boston, MA 02111-1307, USA. # # $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/examples/socket.pl,v 1.7 2004/01/25 06:52:01 muppetman Exp $ # # this was originally gtk-2.2.1/examples/buttonbox/buttonbox.c # ported to gtk2-perl by rm use strict; use Glib qw/TRUE FALSE/; use Gtk2 -init; my $pid; my $socket; my $win = Gtk2::Window->new("toplevel"); $win->set_default_size(640, 480); $win->signal_connect( 'delete_event' => sub { Gtk2->main_quit; kill(2,$pid); 1; }); $socket = Gtk2::Socket->new; $win->add($socket); printf("win: 0x%X\n", $socket->get_id); $pid = fork; if( $pid < 0 ) { die "there's a problem here, fork"; } if( $pid == 0 ) { exec(sprintf("$^X plug.pl %d\n", $socket->get_id)); } my $quitbtn = Gtk2::Button->new_from_stock('gtk-quit'); $quitbtn->signal_connect( 'clicked' => sub { Gtk2->main_quit; 1; }); $socket->signal_connect('plug-removed' => sub { print STDERR "GtkPlug Disconnected\n"; $win->remove($socket); $win->add($quitbtn); $win->set_border_width(50); $quitbtn->show; 1; }); $win->show_all; Gtk2->main; waitpid($pid, 0); #### #!/usr/bin/perl -w # GTK - The GIMP Toolkit # Copyright (C) 1995-1997 Peter Mattis, Spencer Kimball and Josh MacDonald # # Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full # list) # # This library is free software; you can redistribute it and/or modify it under # the terms of the GNU Library General Public License as published by the Free # Software Foundation; either version 2.1 of the License, or (at your option) # any later version. # # This library 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 Library General Public License for # more details. # # You should have received a copy of the GNU Library General Public License # along with this library; if not, write to the Free Software Foundation, Inc., # 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. # # $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/examples/plug.pl,v 1.4 2003/09/22 00:04:23 rwmcfa1 Exp $ # # this was originally gtk-2.2.1/examples/buttonbox/buttonbox.c # ported to gtk2-perl by rm use strict; use Gtk2; die "ERROR: give me a socket" unless( scalar($ARGV[0]) ); sleep(1); Gtk2->init; printf("socket_id: %X\n", $ARGV[0]); my $plug = Gtk2::Plug->new($ARGV[0]); $plug->set_border_width(10); my $hbox = Gtk2::HBox->new(0,5); $plug->add($hbox); my $state = 1; my $img = Gtk2::Image->new_from_stock("gtk-yes", "dialog"); $hbox->pack_start($img, 1, 1, 5); my $vbox = Gtk2::VBox->new(0,5); $hbox->pack_start($vbox, 1, 1, 5); my $btn = Gtk2::Button->new("Click me before exiting!"); $vbox->pack_start($btn, 1, 1, 5); $btn->signal_connect( "clicked" => sub { Gtk2->main_quit; }); my @array = ( $img, $state ); foreach (1..5) { my $btn = Gtk2::Button->new("Just a button $_"); $vbox->pack_start($btn, 1, 1, 5); $btn->signal_connect( "clicked" => sub { print STDERR 'btn: '.$_[0]->get_label.' state: '. $_[1][1]." \n"; if( $_[1][1] ) { $_[1][0]->set_from_stock('gtk-no', 'dialog'); $_[1][1] = 0; } else { $_[1][0]->set_from_stock('gtk-yes', 'dialog'); $_[1][1] = 1; } }, \@array ); } $plug->show_all; Gtk2->main;