#!/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;