#!/usr/bin/perl -w
use Tk;
require Tk::Table;
my ($status_text, $Player, $PlayMap ) = ("","O", " " x 9);
@WinMapper=([0..2], [3..5], [6..8], [0, 3, 6], [1, 4, 7], [2, 5, 8], [0, 4, 8], [2, 4, 6] );
sub ButtonPlay{
my $offset = shift;
$_=$Player;
return if ((/-/)||(substr($PlayMap,$offset,1)!~/\s/));
substr($PlayMap,$offset,1)=$_;
$bouttons[$offset]->configure(
-text => $_ ,
-background =>(/O/)?'#20B000':'#B00020',
-activebackground => (/O/)?'#60F040' : '#F04060');
foreach(@WinMapper){
my ($o1, $o2, $o3) = @{$_};
if($Player x 3 eq substr($PlayMap,$o1,1) . substr($PlayMap,$o2,1 ) . substr( $PlayMap,$o3,1)){
$bouttons[$_]->configure(-background => '#2000B0', -activebackground => '#6040F0' )
foreach($o1,$o2, $o3);
$status_text= $Player." a gagné !", $Player="-";
return;
}
}
$Player =~ y/[OX]/[XO]/;
$status_text = "C'est au tour de $Player de jouer.";
$Player="-", $status_text= "O et X ont perdu !" unless($PlayMap =~ /\s/);
}
my $main=new MainWindow;
$main->title( "MORPION in Perl" );
$main->Label(-text => 'MORPION', -font => "{Arial} 14 {italic}" )
->pack(-side => 'top', -fill => 'x' );
foreach $i(0, 1, 2){
my $cadres = $main->Frame();
foreach $j( 0, 1, 2){
$o=$i*3+$j;
$bouttons[$o]=$cadres->Button( -width =>4, -height => 4 , -text => "-", -command => [ \&ButtonPlay , $o ] );
$bouttons[$o]->pack(-side=>'left' , -fill => 'both', -expand => 1 );
}
$cadres->pack( -fill => 'both', -expand =>1 );
}
$main->Label(-textvariable => \$status_text, -width=>30, -relief => 'ridge' )->pack(-side => 'bottom', -fill => 'x' );
$status_text="C'est au tour de $Player de jouer.";
MainLoop;