QG /WishPerl/Background

WishPerl is a pair of two (small) scripts, one in Perl and one in Tcl, enabling you of painlessly breeding Perl modules with Tcl/Tk/Tix GUI. Works on Unix with perl 5.004, on Mac with MacPerl and MacTk 8.0.4 (thanks to Rich Morin and Chris Nandor), and on Windows NT with YeP-perl (Windows '95 reports sought). With it's help, you can add Tcl/Tk GUI to your Perl program fast, or make a new application with GUI events processed by some Perl engine, or debug your Tcl script easily.

Here is a sample interaction, as implemented in test.pl:

#! /usr/bin/perl -w
# Qub Group 1998 http://www.qub.com
# $Id: test.pl,v 1.17 1998/02/24 22:22:44 eugene Exp $

use PerlWish;

my $wish = new PerlWish();

#$wish->open( "wish" );
$wish->open( "tixwish" );

#$wish->logging( 1, 1 );

$wish->send( "button .quit -text \"Quit\" -command { Perl exit 0; destroy . }\npack .quit\n" );

$wish->send( "button .b -text \"Press me\" -command { Perl main::button_callback \"Some Data\" }; pack .b\n" );
$wish->send( "global perl_func_name; set perl_func_name \"main::button_callback\"\n" );
$wish->send( "global perl_func_name\n .b configure -command { Perl \$perl_func_name \"\$perl_func_name\" }\n" );

$wish->send( "button .hello -text \"Press Button-1 or Button-3\" -command { Perl main::button_callback Button-1 pressed }\npack .hello\n" );
$wish->send( "bind .hello <BUTTON-3> { Perl main::button_callback Button-%b x:\%x y:\%y }\n" );

$wish->send( "button .create_button -text \"Create Button\" -command { Perl main::create_button_callback !PerlWish{PerlWish::self} !PerlWish{main::next_button_number} }\npack .create_button\n" );

my $versions = $wish->tclVersion();
print "tcl_version: $versions->{tcl} " if defined $versions->{tcl};
print "tk_version: $versions->{tk} " if defined $versions->{tk};
print "tix_version: $versions->{tix}" if defined $versions->{tix};
print "\n";

$wish->mainLoop();

$wish->close();

# ----------------------------------------------------------------------

sub button_callback
{
     print STDOUT "button_callback: @_\n";
}

# ----------------------------------------------------------------------

my $next_button_no = 0;
sub next_button_number
{
     return ++$next_button_no;
}

# ----------------------------------------------------------------------

sub create_button_callback
{
     my ($wish,$button_no) = @_;
     #print STDERR "create_button_callback: @_\n";
     $wish->send( "button .button$button_no -text \"Button $button_no\" -command { Perl main::button_callback \"Button $button_no pressed\"; }; pack .button$button_no\n" );
}

# ----------------------------------------------------------------------

Find a bug? Have a suggestion? Have a business proposal? - do tell.

QG /WishPerl/Background
;