17.3. How can I do animations using after?

There is a "toggling button" demo script supplied with Tk called after_demo that makes effective use of after().

Terry Greenlaw <terry@encompass.is.net> of Encompass Technologies posted a character cell animator for the really bored. Here it is in a slightly modified form that allows string input from the command line (note too the recursive call that doesn't sop up system memory):

#!/usr/bin/perl

=head1 NAME

From: z50816@mip.lasc.lockheed.com "Terry Greenlaw"  Thu Feb 1 12:02:24 EST 1996
To: ptk@guest.WPI.EDU
Subj: A code sample for the REALLY bored

For everyone with a case of Browser envy after using Microsoft's Internet
Explorer, here's a perl/tk script only slightly more useful than a script
to do <BLINK>. Don't know why I wrote it. Don't know why you'd run it.
Maybe if you were writing a ticker tape application. Or had a weird thing
for Times Square. Anyway....

tog
Terry Greenlaw (on-site @ Lockheed Martin)      Encompass Technologies
z50816@mip.lasc.lockheed.com                    terry@encompass.is.net

##################################################################

=cut

    #!/usr/bin/perl
    
    #use strict;
    use Tk;
    
    $message=join(' ',@ARGV,''); 
    if (!$message) {
        $message="THIS IS A VERY LONG SCROLLING MESSAGE...      ";
        $topmssg="This is the top of the screen";
        $botmssg="This is the bottom of the screen";
    }
    else {
        $topmssg=$message;
        $botmssg=$message;
    }
    $top = MainWindow->new;
    $l1 = $top->Label(-fg => 'White', -text => $topmssg);
    $l1->pack(-fill => 'both', -expand => 1 );
    $m1 = $top->Label(-fg=>'Red', -bg=>'black',
                      -textvariable => \$message, 
                      -width => 15 
                      );
    $m1->pack();
    $m2 = $top->Label(-wrap=>1, 
                      -fg=>'Green', -bg=>'black',
                      -textvariable => \$message2, 
                      -width=>1, -height=>8 
                      );
    $m2->pack(-anchor=>'w');
    $l2 = $top->Label(-fg => 'White', -text => $botmssg);
    $l2->pack(-fill => 'both', -expand => 1 );
    
    after(100, \&scroll_it);
    
    $top->MainLoop;
    
    sub scroll_it {
        $message =~ /(.)(.*)/;
        $message="$2$1";
        ($message2 = $message) =~ s/ /  /g;
        after(100, \&scroll_it);
    }
    __END__
(Please note that a script like this is now distributed as "TickerTape" in your Tk-b*/Contrib/ directory.)

Previous | Return to table of contents | Next