#!/usr/bin/perl --
use strict;
use warnings;
use Tk;
Main( @ARGV );
exit( 0 );
sub Main {
my $mw = tkinit;
my $marq = marq( $mw , [ 'Anonymous Monk loves the color pink and
+pancakes', ] );
$mw->Button(
-text => 'stop',
-command => sub { $marq->{_marq_timer}->cancel; }
)->pack( qw/ -anchor nw / );
$marq->configure(qw/ -background pink /);
$marq->pack(qw/-anchor nw /);
marq( $mw , [ @INC ] )->pack(qw/-anchor sw -expand both /);
$mw->MainLoop;
}
sub marq {
my( $mw, $messages ) = @_;
my $width = 20;
$messages = ' ' x $width . join(' --- ', @$messages );
my $position = 0;
my $showthis = "";
my $label = $mw->Label( -width => $width, -textvariable => \$showt
+his);
$label->{_marq_timer} = $mw->repeat(
50,
sub {
if( $position > length $messages ){
$position = 0;
}
my $format = '%-'.$width.'s';
my $newmsg = sprintf $format, substr $messages, $position,
+ $width;
$position++;
$showthis = $newmsg;
return;
},
);
return $label;
};
__END__
|