#!/usr/bin/perl -- ## ## ## perltidy -olq -csc -csci=3 -cscl="sub : BEGIN END if " -otr -opr -ce -nibc -i=4 -pt=0 "-nsak=*" #!/usr/bin/perl -- use strict; use warnings; use Tk; use Time::HiRes qw/ usleep /; Main( @ARGV ); exit( 0 ); sub Main { GoTk( 4 ); GoTk( 8 ); } ## end sub Main sub GoTk { my( $many ) = @_; my $mw = tkinit; my @bbs; for my $one ( 1 .. $many ) { push @bbs, $mw->Button( -text, $one, -command, [ \&bbs_exclusive, ], )->pack; } $bbs[ rand @bbs ]->focus; $mw->$_ for qw/ withdraw deiconify raise focusForce update /; $mw->MainLoop; } ## end sub GoTk sub bbs_exclusive { my $ev = $Tk::event; my $bClicked = $Tk::widget; my @bbs = grep { $_->isa( 'Tk::Button' ) } $bClicked->parent->children; $_->configure( -state => 'disabled' ) for @bbs; for( 1 .. 10 ) { for my $bb ( @bbs ) { my $t = $bb->cget( -text ); $t .= ' #'; $bb->configure( -text, $t ); $bb->update; } usleep 100 * 1000; # sleep for 100*1 millisecond } for my $bb ( @bbs ) { my $t = $bb->cget( -text ); $t =~ s{(?:\Q #\E)*$}{}; $bb->configure( -text, $t ); $bb->configure( -state, 'normal' ); } } ## end sub bbs_exclusive __END__