#!/usr/bin/perl -w

use Tk;
use strict;

my (
    $main,
    $n_group,
    $n_item,
    $i,
    $j,
);

$n_group = 4;
$n_item = 3;

$main = MainWindow->new();
for ($i=0; $i<$n_group; ++$i) {
    $main->{"f$i"} = $main->Frame(-bd=>4, -bg=>"gray", Name=>"f$i");
    $main->{"f$i"}->pack(-side=>"left", -fill=>"both");
    $main->{"f$i"}->bind("<Button>", \&complain);
    for ($j=0; $j<$n_item; ++$j) {
	$main->{"f$i"}{"b$j"} = $main->{"f$i"}->Button(
	    -text=>"  ", -command=>[\&relinquish, $i]);
	$main->{"f$i"}{"b$j"}->pack(-side=>"top", -fill=>"both");
    }
}

$main->{"f0"}->grab;
$main->{"f0"}->configure(-bg=>"red");

MainLoop();

#=================================================================

sub complain {
# "bind" ┮﹚ callback, 笆穦钡Μ肂把计 (﹚ㄤ
# 把计ぇ玡): "ㄆン琌ê widget 讽い祇ネ㎡?"
    my ($w) = @_;
    print $w->PathName, ": click no one else but me!\n";
    for (my $i=0; $i<3; ++$i) {
	$w->configure(-bg=>"blue");
	$w->idletasks;
	$w->after(100);
	$w->configure(-bg=>"red");
	$w->idletasks;
	$w->after(100);
    }
}

sub relinquish {
# 琌 "-command" ┮﹚ callback, 玥⊿Τ肂把计.
    my ($i) = @_;

    if ($main->{"f$i"}->cget(-bg) eq "gray") {
	print "No, not me, I am not allowed to respond now, sorry!\n";
	return;
    }
    $main->{"f$i"}->configure(-bg=>"gray");
    my ($chosen) = int(rand($n_group-1));
    $chosen = $n_group - 1 if $chosen == $i;
    $main->{"f$chosen"}->grab;
    $main->{"f$chosen"}->configure(-bg=>"red");
}