Reversi

use Tk;
use strict;
use warnings;
use utf8;

my $mw        = MainWindow->new;
my $main_menu = $mw->Menu();
$mw->bind(
    '<Tab>',
    sub {
        $mw->after( 1, sub { $mw->focus } );
    }
);

$mw->configure( -menu => $main_menu );

my $btn = $main_menu->Menubutton(
    -text      => "File",
    -underline => 0,
    -tearoff   => 0
);
$btn->command(
    -label            => "New Game",
    -activebackground => "orange",
    -foreground       => "green",
    -command          => [ \&start ]
);

$btn->command(
    -label            => "Away",
    -activebackground => "red",
    -activeforeground => "black",
    -background       => "blue",
    -foreground       => "white",
    -command          => sub { $mw->messageBox( -message => "Ups" ) }
);

$btn->command( -label => "Exit", -command => sub { exit } );

my $help = $main_menu->Menubutton(
    -text      => "Help",
    -underline => 0,
    -tearoff   => 0
);
$help->command(
    -label            => "How to play",
    -activebackground => "red",
    -foreground       => "black",
    -command          => \&help
);

$help->command(
    -label            => "About author",
    -activebackground => "orange",
    -activeforeground => "black",
    -background       => "yellow",
    -foreground       => "blue",
    -command          => \&myself
);

$mw->title('Reversi');
$mw->geometry("545x402");
$mw->resizable( 0, 0 );

my $canvas = $mw->Canvas(
    -width      => 380,
    -height     => 380,
    -background => "black",
    -relief     => "groove",

)->pack( -side => "left" );
my $frame = $mw->Frame(
    -width  => 112,
    -height => 400
)->pack( -side => "right" );
my $icon = $mw->Photo( -file => '1.bmp' );
$mw->iconimage($icon);

my @pole;

my @right = ();

my $u = 1;

my $semafor = 0;

my $task;

my $x = 12;

my $y = 12;

for ( $x = 12 ; ( $x + 40 ) < 400 ; $x += 45 ) {

    for ( $y = 12 ; ( $y + 40 ) < 400 ; $y += 45 ) {

        my $rec = $canvas->createRectangle(

            $x, $y, $x + 40, $y + 40,

            -fill => "red",

            -outline => "orange",

            -width => 2.0

        );

        my $oval = $canvas->createOval(

            $x + 2, $y + 2, $x + 38, $y + 38,

            -fill => "red",

            -outline => "red"

        );

        $canvas->bind( $oval, '<ButtonPress>' => [ \&callBack, $oval ] );

    }

    $y = 10;

}

my $start = $frame->Button(

    -text    => 'Start',
    -width   => 18,
    -command => [ \&start ],

)->grid( -row => 0, -column => 0, -pady => 10, -padx => 20 );
$canvas->pack;

my $type_game = $frame->Button(
    -text    => "Choose type of game",
    -width   => 18,
    -command => \&button1_sub
)->grid( -row => 1, -column => 0, -padx => 20 );

my $result     = $frame->Label()->grid( -row => 2, -column => 0 );
my $currentHod = $frame->Label()->grid( -row => 3, -column => 0 );
my $typeGame   = 0;

sub myself {
    my $i = $mw->Toplevel;
    $i->geometry("200x150");
    $i->resizable( 0, 0 );
    $i->title("How to play");
    $i->Label( -text => "Was made by Ksenia Panina. All rights reserved" )
      ->pack();
    my $exit = $i->Button(
        -text    => "Exit",
        -command => [ $i => 'destroy' ]
    )->pack();

}

sub help {
    my $text;
    open( FILE, "htp.txt" ) or die;

    close(FILE);
    my $help = $mw->Toplevel;
    $help->geometry("330x430");
    $help->resizable( 0, 0 );
    $help->title("How to play");
    $help->Label( -text => $text )->pack();
    my $exit = $help->Button(
        -text    => "Exit",
        -command => [ $help => 'destroy' ]
    )->pack();

}

#0- User vs AI
#1- User vs User
#2 AI vs AI

sub button1_sub {
    my $game = $mw->Toplevel;
    $game->geometry("300x150");
    $game->title("Choosing type");

    my $radio_frame = $game->Frame()->pack();
    $radio_frame->Label( -text => "Type of game:" )->pack();
    my $radio_us_ai = $radio_frame->Radiobutton(
        -text     => "User vs Computer",
        -value    => "0",
        -variable => \$typeGame
    )->pack( -side => "top" );
    my $radio_us_us = $radio_frame->Radiobutton(
        -text     => "User vs User",
        -value    => "1",
        -variable => \$typeGame
    )->pack( -side => "top" );
    my $radio_ai_ai = $radio_frame->Radiobutton(
        -text     => "Computer vs Computer",
        -value    => "2",
        -variable => \$typeGame
    )->pack( -side => "top" );
    my $game_ex = $game->Button(
        -text    => "OK",
        -command => [ $game => 'destroy' ]
    )->pack();
}
MainLoop();

sub start {
    $canvas->afterCancel($task);

    setUp();

    #   $type_game->configure(-state => "disabled" );
    #   $canvas->itemconfigure( $type_game, - => "black" );
    nextUser(1);
}

sub setUp {

    for ( my $i = 0 ; $i < 8 ; $i++ ) {

        for ( my $j = 0 ; $j < 8 ; $j++ ) {

            $pole[$i][$j] = 0;

        }

    }

    for ( my $i = 2 ; $i <= 8 * 8 * 2 ; $i += 2 ) {

        $canvas->itemconfigure( $i, -fill => "red" );

    }

    $pole[3][3] = 1;

    $pole[4][4] = 1;

    $pole[3][4] = 2;

    $pole[4][3] = 2;

    $u = 2;

    push @right, 3, 4, 4, 3;

    draw();

    $u = 1;

    push @right, 3, 3, 4, 4;

    draw();
    $result->configure( -text => "Black: 0 White: 0 Free: 64" );
}

sub nextUser {
    my $nextUser = $_[0];  #Кому надо будет передать ход

    $currentHod->configure(
        -text => "Current: " . ( ( $nextUser == 1 ) ? "Black" : "White" ) );
    if ( $typeGame == 0 || $typeGame == 2 ) {    # если юзер мы АИ
        if ( $nextUser == 2 || $typeGame == 2 ) {    #если ход бота
            $semafor = 0;  #выключаем ходы пользователю
            $task = $canvas->after( 500, \&callAI );  #вызываем бота
        }
        else {    #если ход юзера
            $semafor =
              1;    #включаем ему возможность ходить
        }
    }
    elsif ( $typeGame == 1 ) {
        $semafor = 1;
    }

}

sub callBack {

    my $c;

    my $d;

    $b = $_[1];

    $c = int( ( $b - 2 ) / 16 );

    $d = ( ( $b - 2 ) % 16 ) / 2;

    if ($semafor) {

        if ( hod( $c, $d ) ) {
            nextUser($u);

        }

    }

}

sub f {

    my $x = shift;    #координаты

    my $y = shift;

    my $sdvig_x = shift;    # и на сколько мы их сдвигаем

    my $sdvig_y = shift;

    my @ther = ();

    $x += $sdvig_x;

    $y += $sdvig_y;

    while ( $x < 8 && $x >= 0 && $y < 8 && $y >= 0 )

    {                       #цикл начался

        if ( $pole[$x][$y] == 0 ) {    #если 0 то выходим

            last;

        }

        if (

            $pole[$x][$y] ==

            ( $u == 1 ? 2 : 1 )

          )                            #если 1 кладём 2 иначе 1

        {    # если вражеские то кладём

            push @ther, $x, $y;

            #print $x, $y, $pole[$x][$y];

            $x += $sdvig_x;

            $y += $sdvig_y;

        }

        else {

            if ( $pole[$x][$y] == $u ) {

                push @right, @ther;

                last;

            }

        }

    }

    #конец цикла

}

#каждый элимент поля 1 - чёрный,2 - белый,0 - пустой

#функция которая говорит сделан ли ход

sub hod {

    #берем координаты хода

    my $a = $_[0];

    my $b = $_[1];

    #берем флаг count

    my $countFlag = $_[2];

    if ( $pole[$a][$b] == 0 ) {

        #проверка в поисках фишки того же юзера

        #проверка по строкам

        f( $a, $b, +1, 0 );

        f( $a, $b, -1, 0 );

        #проверка по столбцам

        f( $a, $b, 0, -1 );

        f( $a, $b, 0, 1 );

        #диагональки

        f( $a, $b, -1, -1 );

        f( $a, $b, +1, +1 );

        f( $a, $b, +1, -1 );

        f( $a, $b, -1, +1 );

        if ( scalar @right == 0 ) {

            return 0;

        }

        else {

            my $rightLen = scalar @right;

            if ( !$countFlag ) {

                push @right, $a, $b;

                #print $a, $b;

                for ( my $i = 0 ; $i < ( scalar @right ) ; $i += 2 ) {

                    $pole[ $right[$i] ][ $right[ $i + 1 ] ] = $u;

                }    #меняем состояние нужной клетки

                draw();
                my @res = getResult();
                $result->configure(
                    -text => "Black: $res[1] White: $res[2] Free: $res[0]" );
                $u = $u == 1 ? 2 : 1;    #переход хода

                my @hod = getHod($u);

                if ( !$hod[2] ) {
                    @hod = getHod( $u == 1 ? 2 : 1 );

                    if ( !$hod[2] ) {

                        $semafor = 0;

                        $currentHod->configure( -text => "Game over" );
                        return 0;

                    }

                    $u = $u == 1 ? 2 : 1;

                    return 1;

                }

            }

            @right = ();

            return $rightLen;

        }

    }

}

sub getHod {

    my $buf_u = $u;

    $u = $_[0];

    my $lenHod = 0;

    my $a = 0;

    my $b = 0;

    for ( $x = 0 ; $x < 8 ; $x++ ) {

        for ( $y = 0 ; $y < 8 ; $y++ ) {

            if ( hod( $x, $y, 1 ) > $lenHod ) {

                $lenHod = hod( $x, $y, 1 );

                $a = $x;

                $b = $y;

            }

        }

    }

    $u = $buf_u;

    return ( $a, $b, $lenHod );

}

sub draw {

    for ( my $i = 0 ; $i < ( scalar @right ) ; $i += 2 ) {

        my $id = $right[$i] * 16 + $right[ $i + 1 ] * 2 + 2;

        if ( $u == 1 ) {

            $canvas->itemconfigure( $id, -fill => "black" );

        }

        else {

            $canvas->itemconfigure( $id, -fill => "white" );

        }

    }

    @right = ();

}

sub getResult {

    my @result = ( 0, 0, 0 );

    for ( $x = 0 ; $x < 8 ; $x++ ) {

        for ( $y = 0 ; $y < 8 ; $y++ ) {

            $result[ $pole[$x][$y] ]++;

        }

    }

    print "user: ", $result[1], "; AI: ", $result[2], "\n";
    return @result;
}

#AI section

sub callAI {

    my @hod = getHod($u);

    if ( hod( $hod[0], $hod[1] ) ) {

        nextUser($u);
    }

}