home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _22339b857437d63982fbecc8f73d50d3 < prev    next >
Encoding:
Text File  |  2004-06-01  |  1.4 KB  |  52 lines
  1. # hello.pl
  2.  
  3. use Config;
  4. use Tk::widgets qw/ ROText /;
  5. use vars qw/ $TOP /;
  6. use strict;
  7.  
  8. sub hello {
  9.  
  10.     my( $demo ) = @_;
  11.  
  12.     $TOP = $MW->WidgetDemo(
  13.         -name             => $demo,
  14.         -text             => [ "This demonstration describes the basics of Perl/Tk programming. Besides this small user guide, there are various FAQs and other resources and tutorials available on the web, such as:
  15.  
  16. http://phaseit.net/claird/comp.lang.perl.tk/ptkFAQ.html
  17. http://www.perltk.org
  18. http://user.cs.tu-berlin.de/~eserte
  19. http://www.lehigh.edu/sol0/ptk
  20. ", -wraplength => '7i' ],
  21.         -title            => 'Perl/Tk User Guide',
  22.         -iconname         => 'hello',
  23.     );
  24.  
  25.     # Pipe perldoc help output via fileevent() into a Scrolled ROText widget.
  26.  
  27.     my $t = $TOP->Scrolled(
  28.         qw/ ROText -width 80 -height 25 -wrap none -scrollbars osoe/,
  29.     );
  30.     $t->focus;
  31.     my $cmd = $Config{installbin} . '/perldoc -t Tk::UserGuide';
  32.     $t->pack( qw/ -expand 1 -fill both / );
  33.  
  34.     open( H, "$cmd|" ) or die "Cannot get pTk user guide: $!";
  35.     $TOP->fileevent( \*H, 'readable' => [ \&hello_fill, $t ] );
  36.  
  37. } # end hello
  38.  
  39. sub hello_fill {
  40.  
  41.     my( $t ) = @_;
  42.  
  43.     my $stat = sysread H, my $data, 4096;
  44.     die "sysread error:  $!" unless defined $stat;
  45.     if( $stat == 0 ) {        # EOF
  46.     $TOP->fileevent( \*H, 'readable' => '' );
  47.     return;
  48.     }
  49.     $t->insert( 'end', $data );
  50.  
  51. } # end hello_fill
  52.