tictactoe.pl

use strict;
use vars qw($VERSION %IRSSI);

use Irssi;
use Text::ParseWords;

$VERSION = '0.01';
%IRSSI = (
    authors	=> 'bw1',
    contact	=> 'bw1@aol.at',
    name	=> 'tictactoe',
    description	=> 'tic-tac-toe game',
    license	=> 'LGPLv3',
    url		=> 'https://scripts.irssi.org/',
    changed	=> '2019-06-07',
    modules => 'Text::ParseWords',
    commands=> 'tictactoe',
);

my $help = << "END";
%9Name%n
  $IRSSI{name}
%9Version%n
  $VERSION
%9description%n
  $IRSSI{description}

  start the game:
    /tictactoe game
    nick: !game
  print the board
    /tictactoe board
    nick: !board
  drop a stone
    /tictactoe b0
    nick: !b0
END

my ($server, $nick, $target, $witem, $type);

# 0= free, 1= stone player1, 2= stone player2
my @board= (
	[0,1,2],
	[0,2,0],
	[0,0,0],
);
my $step_counter=3;

# 0= free, 1= i, 2= you, 3=whatever
my @gray= (
	# over
	[[1,1,1],[3,3,3],[3,3,3], 0,0, -1],
	[[3,3,3],[1,1,1],[3,3,3], 0,0, -1],
	[[1,3,3],[3,1,3],[3,3,1], 0,0, -1],

	[[2,2,2],[3,3,3],[3,3,3], 0,0, -2],
	[[3,3,3],[2,2,2],[3,3,3], 0,0, -2],
	[[2,3,3],[3,2,3],[3,3,2], 0,0, -2],
	# last
	[[1,1,0],[3,3,3],[3,3,3], 0,2, 1],
	[[0,1,1],[3,3,3],[3,3,3], 0,0, 1],
	[[1,0,1],[3,3,3],[3,3,3], 0,1, 1],

	[[3,3,3],[1,1,0],[3,3,3], 1,2, 1],
	[[3,3,3],[0,1,1],[3,3,3], 1,0, 1],
	[[3,3,3],[1,0,1],[3,3,3], 1,1, 1],

	[[1,3,3],[3,1,3],[3,3,0], 2,2, 1],
	[[1,3,3],[3,0,3],[3,3,1], 1,1, 1],
	# no 3
	[[2,2,0],[3,3,3],[3,3,3], 0,2, 0],
	[[0,2,2],[3,3,3],[3,3,3], 0,0, 0],
	[[2,0,2],[3,3,3],[3,3,3], 0,1, 0],

	[[3,3,3],[2,2,0],[3,3,3], 1,2, 0],
	[[3,3,3],[0,2,2],[3,3,3], 1,0, 0],
	[[3,3,3],[2,0,2],[3,3,3], 1,1, 0],

	[[2,3,3],[3,2,3],[3,3,0], 2,2, 0],
	[[2,3,3],[3,0,3],[3,3,2], 1,1, 0],
	#
	[[2,0,0],[0,2,0],[3,0,1], 0,2, 0],
	[[2,0,3],[0,2,0],[0,0,1], 2,0, 0],
	# d3
	[[2,0,0],[3,3,0],[3,3,2], 0,1, 0],
	[[2,0,0],[3,2,3],[3,0,3], 0,1, 0],
	[[2,3,3],[0,2,0],[0,3,3], 1,0, 0],
	[[0,2,0],[2,3,3],[0,3,3], 0,0, 0],
	[[0,2,0],[0,3,3],[2,3,3], 0,0, 0],
	[[0,0,2],[2,3,3],[0,3,3], 0,0, 0],
	# M
	[[3,3,3],[3,0,3],[3,3,3], 1,1, 0],
	# M2
	[[3,3,3],[3,2,3],[3,3,0], 2,2, 0],
);

# game state
# 0 off
# 10 player[0] turn
# 20 player[1] turn
# 30 vs computer
my $state=0;
# player
my @player=();

sub rotate {
	my ($r) =@_;
	my @ca;
	for(my $c=0; $c <3; $c++) {
		push @ca,$board[$c][0];
	}
	push @ca,$board[2][1];
	for(my $c=2; $c >-1; $c--) {
		push @ca,$board[$c][2];
	}
	push @ca,$board[0][1];

	for(my $c=0; $c <$r*2; $c++) {
		push @ca, shift(@ca);
	}

	for(my $c=0; $c <3; $c++) {
		$board[$c][0]= shift(@ca);
	}
	$board[2][1]= shift(@ca);
	for(my $c=2; $c >-1; $c--) {
		$board[$c][2]= shift(@ca);
	}
	$board[0][1]= shift(@ca);
}

sub compute {
	my ($max)= @_;
	my $res;
	my $mc=0;
	foreach my $s (@gray) {
		for(my $r=0; $r<4; $r++) {
			my $ok=1;
			for(my $x=0; $x <3; $x++) {
				for(my $y=0; $y <3; $y++) {
					if ($s->[$x][$y] !=3) {
						if ($s->[$x][$y] != $board[$x][$y]) {
							$ok=0;
							last;
						}
					}
				}
				last if ($ok==0);
			}
			if ($ok == 1) {
				if (!defined $res) {
					$res =$s->[5];
					if ($s->[5] >=0) {
						$board[$s->[3]][$s->[4]]=1;
						$step_counter++;
					}
				}
			}
			rotate(1);
		}
		last if (defined $res);
		$mc++;
		last if (defined($max) && $mc > $max);
	}
	return $res;
}

# step_in('a1',2);
sub step_in {
	my ($st,$player) = @_;

	return 1 if (length($st) != 2);
	my $y = ord(lc(substr($st,0,1))) -97;
	return 2 if ($y <0 || $y >2);
	my $x = substr($st,1,1);
	return 3 if ($x <0 || $x >2);
	return 4 if ($board[$x][$y] !=0);
	$board[$x][$y]= $player;
	$step_counter++;
	return 0;
}

sub sc_clear {
	for(my $x=0; $x <3; $x++) {
		for(my $y=0; $y <3; $y++) {
			$board[$x][$y]=0;
		}
	}
	$step_counter=0;
}

# return state
# 0 normal step
# 1 last step by computer
# -1 computer win
# -2 computer lost
# -5 draw
sub sc_compute {
	my $st=0;
	my $max;
	if ($player[1]->{difficult} eq 'e') {
		$max=5;
	}
	if ($player[1]->{difficult} eq 'n') {
		$max=5+8;
	}
	if ($player[1]->{difficult} eq 'i') {
		$max=5+8+10;
	}
	if ($player[1]->{difficult} eq 'a') {
		$max=5+8+10+6;
	}
	if ($player[1]->{difficult} eq 'x') {
		$max=undef;
	}
	my $res=compute($max);
	if (!defined $res) {
		my $r= random();
		if ($r) {
			$st=-5;
		}
	} else {
		if ($res <0 || $res ==1) {
			$st=$res;
		}
	}
	if ($step_counter == 9 && $st == 0) {
		$st= -5;
	}
	return $st;
}

sub sc_check {
	my $r= compute(5);
	if (!defined $r && $step_counter == 9) {
		$r= -5;
	}
	return $r;
}

sub random {
	my $r = int(rand()*10)+1;
	my $c;
	while ($r >0 ) {
		$c=0;
		for(my $x=0; $x <3; $x++) {
			for(my $y=0; $y <3; $y++) {
				if ($board[$x][$y]==0) {
					$r--;
				} else {
					$c++;
				}
				if ($r <=0) {
					$board[$x][$y]=1;
					$step_counter++;
					last;
				}
			}
			last if ($r <=0);
		}
		last if ( $c >=8);
	}
	return ($c >=8);
}

sub def_player {
	my ($num)= @_;
	if (defined $witem) {
		$player[$num]->{type}='L';
	}
	if (defined $type) {
		$player[$num]->{type}=$type;
	}
	if (defined $server) {
		$player[$num]->{server}=$server->{tag};
	}
	if (defined $target) {
		$player[$num]->{target}=$target;
	}
}

sub board {
	my $str= "   %9abc%n\n";
	my %c = (
		0=>' ',
		1=>$player[1]->{stone},
		2=>$player[0]->{stone},
	);
	for(my $x=0; $x<3; $x++) {
		my $r="%9 $x%n ";
		for(my $y=0; $y<3; $y++) {
			$r .= $c{$board[$x][$y]};
		}
		$str .= $r."\n";
	}
	$str .= "\n";
	return $str;
}

sub cmd {
	my ($args, $server, $wi)=@_;
	my @args = grep { $_ ne ''}  quotewords('\s+', 0, $args);
	$witem= $wi;
	$type= 'L';
	subcmd(@args);
	$type= undef;
	$witem= undef;
}

sub cmd_help {
	my ($args, $server, $witem)=@_;
	$args=~ s/\s+//g;
	if ($IRSSI{name} eq $args) {
		Irssi::print($help, MSGLEVEL_CLIENTCRAP);
		Irssi::signal_stop();
	}
}

sub subcmd {
	my (@args) =@_;
	my $a= $args[0];
	if ($a eq 'help' || $a eq '') {
		out($help);
	}
	if ($a eq 'board') {
		out(board(),1);
	}
	# init
	if ($state==0 && $a eq 'game') {
		$state=1;
		$player[0]->{nick}=$nick;
		def_player(0);
		if ($type eq 'L') {
			$a='c';
		} else {
			out('%9tictactoe%n vs %gc%nomputer or vs %gh%numan?');
		}
	}
	if ($state==1 && $player[0]->{nick} eq $nick &&  $a =~ m/^c/) {
		$state=2;
		$player[1]->{computer}=1;
		out('difficulty: %ge%nasy, %gn%novice, %gi%nntermediate, '.
			'%ga%ndvanced, e%gx%npert?');
		#   e asy
		#   n ovice
		#   i ntermediate
		#   a dvanced
		# e x pert
	}
	if ($state==2 && $player[0]->{nick} eq $nick &&  $a =~ m/^([eniax])/) {
		$state=3;
		$a='';
		$player[1]->{difficult}=$1;
		out('%gX%n or %gO%n?');
	}
	# game start vs computer
	if ($state==3 && $player[0]->{nick} eq $nick &&  $a =~ m/^[xo]$/i) {
		$state=30;
		sc_clear();
		$player[0]->{win}=0;
		$player[0]->{draw}=0;
		$player[1]->{win}=0;
		if (lc($a) eq 'x') {
			$player[0]->{stone}='X';
			$player[1]->{stone}='O';
		} else {
			$player[0]->{stone}='O';
			$player[1]->{stone}='X';
			# compute
			sc_compute();
		}
		out(board(),1);
	}
	# play vs computer
	if ($state==30 && $player[0]->{nick} eq $nick &&  $a =~ m/^[abc][012]$/i) {
		$state=30;
		if (step_in($a,2) == 0) {
			my $r=sc_compute();
			if ( $r==0 || $r==1 || $r==-5 ) {
				out(board(),1);
			}
			if ( $r== -5 ) {
				$state=31;
				$player[0]->{draw}++;
				out("draw");
			}
			if ( $r== 1 || $r== -1 ) {
				$state=31;
				$player[1]->{win}++;
				out("computer win");
			}
			if ( $r== -2 ) {
				$state=31;
				$player[0]->{win}++;
				out("you win");
			}
			if ($state==31) {
				out("play a gain? (%gy%nes or %gn%no)");
			}
		}
	}
	if ($state==31 && $player[0]->{nick} eq $nick &&  $a =~ m/^[yn]/i) {
		if ( $a=~ m/^n/i) {
			my $s="%9computer%n:$player[1]->{win} %9draw%n:$player[0]->{draw} ";
			$s .= "%9";
			if ( $player[0]->{nick} eq '' ) {
				$s .= "you";
			} else {
				$s .=$player[0]->{nick};
			}
			$s .="%n:$player[0]->{win}";
			out($s);
			@player=();
			$state=0;
		} else {
			# game
			$state=30;
			sc_clear();
			my $s= $player[0]->{stone};
			$player[0]->{stone}= $player[1]->{stone};
			$player[1]->{stone}= $s;
			if ($player[1]->{stone} eq 'X') {
				sc_compute();
			}
			out(board(),1);
		}
	}
	# init vs human
	if ($state==1 && $player[0]->{nick} eq $nick &&  $a =~ m/^h/) {
		$state=5;
		out("player 2 ? (".mynick().": !%gg%name)",1);
	}
	if ($state==5 && $player[0]->{nick} ne $nick &&  $a =~ m/^g/) {
		$player[1]->{nick}=$nick;
		my $r =int(rand(10)) % 2;
		sc_clear();
		$player[0]->{win}=0;
		$player[0]->{draw}=0;
		$player[1]->{win}=0;
		out(board(),1);
		if ($r == 0) {
			$player[0]->{stone}='X';
			$player[1]->{stone}='O';
			$state=10;
			out("your turn", 0, $player[0]->{nick});
		} else {
			$player[0]->{stone}='O';
			$player[1]->{stone}='X';
			$state=20;
			out("your turn", 0, $player[1]->{nick});
		}
	}
	# play vs human
	if ($state==10 && $player[0]->{nick} eq $nick &&  $a =~ m/^[abc][012]$/) {
		if (step_in($a,2) == 0) {
			my $r= sc_check();
			if (!defined $r) {
				$state=20;
				out(board(),1);
				out("your turn", 0, $player[1]->{nick});
			} else {
				$state=11;
				human_end($r);
			}
		}
	}
	if ($state==20 && $player[1]->{nick} eq $nick &&  $a =~ m/^[abc][012]$/) {
		if (step_in($a,1) == 0) {
			my $r= sc_check();
			if (!defined $r) {
				$state=10;
				out(board(),1);
				out("your turn", 0, $player[0]->{nick});
			} else {
				$state=11;
				human_end($r);
			}
		}
	}
	# play again vs human
	if ($state==11 &&
			($player[1]->{nick} eq $nick || $player[0]->{nick} eq $nick)
				 &&  $a =~ m/^[yn]/) {
		if ($a =~ m/^y/i) {
			sc_clear();
			my $s= $player[0]->{stone};
			$player[0]->{stone}= $player[1]->{stone};
			$player[1]->{stone}= $s;
			out(board(),1);
			if ($player[1]->{stone} eq 'X') {
				$state=20;
				out("your turn", 0, $player[1]->{nick});
			} else {
				$state=10;
				out("your turn", 0, $player[0]->{nick});
			}
		} else {
			$state=0;
			my $s="%9";
			if ( $player[1]->{nick} eq '' ) {
				$s .= "you";
			} else {
				$s .=$player[1]->{nick};
			}
			$s .= "%n:$player[1]->{win} %9draw%n:$player[0]->{draw} ";
			$s .= "%9";
			if ( $player[0]->{nick} eq '' ) {
				$s .= "you";
			} else {
				$s .=$player[0]->{nick};
			}
			$s .="%n:$player[0]->{win}";
			out($s);
			@player=();
		}
	}
}

sub human_end {
	my ($result)= @_;
	out(board(),1);
	if ($result == -5) {
		out("draw",1);
		$player[0]->{draw}++
	}
	if ($result == -1) {
		out("$player[1]->{nick} win",1);
		$player[1]->{win}++
	}
	if ($result == -2) {
		out("$player[0]->{nick} win",1);
		$player[0]->{win}++
	}
	out("play again (%gy%nes or %gn%no)",1);
}

sub to_irc_color {
	my ($str)= @_;
	$str =~ s/%9/\x{3}2/g;
	$str =~ s/%g/\x{3}3/g;
	$str =~ s/%n/\x{3}/g;
	$str =~ s/%%/%/g;
	return $str;
}

sub out {
	my ($str, $neutral, $ni ) =@_;
	my @l =split /\n/,$str;
	$nick= $ni if (defined $ni);
	foreach my $r (@l) {
		if ($player[0]->{type} eq 'C') {
			my $s= $player[0]->{server};
			my $t= $player[0]->{target};
			if ( $neutral== 1) {
				Irssi::command("/msg -$s $t ".to_irc_color($r));
			} else {
				Irssi::command("msg -$s $t $nick: ".to_irc_color($r));
			}
		} elsif ($player[0]->{type} eq 'Q') {
			my $s= $player[0]->{server};
			my $t= $player[0]->{target};
			if ( $neutral== 1) {
				Irssi::command("/msg -$s $t ".to_irc_color($r));
			} else {
				Irssi::command("msg -$s $t $nick: ".to_irc_color($r));
			}
		} elsif (defined $witem) {
			$witem->print($r, MSGLEVEL_CLIENTCRAP);
		} else {
			Irssi::print($r, MSGLEVEL_CLIENTCRAP);
		}
	}
}

sub mynick {
	my $n;
	if (defined $server) {
		$n= $server->{nick};
	}
	if (defined $witem) {
		my $s= $witem->{server};
		$n= $s->{nick};
	}
	return $n;
}

sub sig_message_public {
	my ($se, $msg, $ni, $address, $ta)= @_;
	$type='C';
	$server=$se;
	$nick=$ni;
	$target=$ta;
	my @args = grep { $_ ne ''}  quotewords('\s+', 0, $msg);
	my $to =shift @args;
	if ($to =~ m/^\Q$se->{nick}\E[:]?$/ ) {
		if( $args[0] =~ m/^!(.*)$/ ) {
			$args[0] = $1;
			subcmd(@args);
		}
	}
	$type=undef;
	$server=undef;
	$nick=undef;
	$target=undef;
}

sub sig_message_private {
	my ($se, $msg, $ni, $address, $ta)= @_;
	$type='Q';
	$server=$se;
	$nick=$ni;
	$target=$ni;
	my @args = grep { $_ ne ''}  quotewords('\s+', 0, $msg);
	if ( $args[0] =~ m/^!(.*)$/ ) {
		$args[0] = $1;
		subcmd(@args);
	}
	$type=undef;
	$server=undef;
	$nick=undef;
	$target=undef;
}

sub sig_message_own_private {
	my ($se, $msg, $ta, $orig_target)= @_;
	$server=$se;
	$type='Q';
	$nick=$se->{nick};
	$target=$ta;
	my @args = grep { $_ ne ''}  quotewords('\s+', 0, $msg);
	if ( $args[0] =~ m/^!(.*)$/ ) {
		$args[0] = $1;
		subcmd(@args);
	}
	$type=undef;
	$server=undef;
	$nick=undef;
	$target=undef;
}

sub sig_message_own_public {
	my ($se, $msg, $ta)= @_;
	$server=$se;
	$type='C';
	$nick=$se->{nick};
	$target=$ta;
	my @args = grep { $_ ne ''}  quotewords('\s+', 0, $msg);
	if ( $args[0] =~ m/^!(.*)$/ ) {
		$args[0] = $1;
		subcmd(@args);
	}
	$type=undef;
	$server=undef;
	$nick=undef;
	$target=undef;
}

Irssi::signal_add("message own_public", \&sig_message_own_public);
Irssi::signal_add("message own_private", \&sig_message_own_private);
Irssi::signal_add("message public", \&sig_message_public);
Irssi::signal_add("message private", \&sig_message_private);

Irssi::command_bind($IRSSI{name}, \&cmd);
Irssi::command_bind('help', \&cmd_help);