#!/usr/bin/perl -w
$| =1;
use base qw(Aw::Adapter);
use Aw;
my $move;
my ($false, $true) = (0,1);
my $tttEvent = "PerlDevKit::TicTacToe";
my $tttEventRequest = "PerlDevKit::TicTacToeRequest";
# This adapter was originally created to play against
# an Apache server child.
#
# this is a hack to allow the adapter to play against
# the "tictactoe" client script in addition to Apache.
# The "tictactoe" scripts were originally intended to
# play against one another. They maintain their own
# boards and just send one another their latest move.
#
# This hack is easier than updating the clients to
# transmit their entire game board. Which is required
# with apache since the apache child process can not
# guarantee persistance.
#
# We assume that the adapter interacts with only one
# client script at a time, so we just maintain a single
# board.
#
@staticBoard = ();
##
# White's current position. The computer is white.
#
my $white = 0;
##
# Black's current position. The user is black.
#
my $black = 0;
##
# The squares in order of importance...
#
my @moves = (4, 0, 2, 6, 8, 1, 3, 5, 7);
##
# The winning positions.
#
my @won = ();
$#won = (1 << 9);
my $DONE = (1 << 9) - 1;
my $OK = 0;
my $WIN = 1;
my $LOSE = 2;
my $STALEMATE = 3;
sub resetStaticBoard
{
@staticBoard = ( 'e', 'e', 'e', 'e', 'e', 'e', 'e', 'e', 'e' );
}
##
# Mark all positions with these bits set as winning.
#
sub isWon
{
my $pos = shift;
for ( my $i = 0; $i < $DONE; $i++ ) {
if ( ($i & $pos) == $pos ) {
$won[$i] = $true;
}
}
}
##
# Initialize all winning positions.
#
sub init
{
isWon ( (1 << 0) | (1 << 1) | (1 << 2) );
isWon ( (1 << 3) | (1 << 4) | (1 << 5) );
isWon ( (1 << 6) | (1 << 7) | (1 << 8) );
isWon ( (1 << 0) | (1 << 3) | (1 << 6) );
isWon ( (1 << 1) | (1 << 4) | (1 << 7) );
isWon ( (1 << 2) | (1 << 5) | (1 << 8) );
isWon ( (1 << 0) | (1 << 4) | (1 << 8) );
isWon ( (1 << 2) | (1 << 4) | (1 << 6) );
}
##
# Compute the best move for white.
# @return the square to take
sub bestMove
{
my $bestmove = -1;
for ( my $i = 0; $i < 9; $i++ ) {
my $mw = $moves[$i];
if ( (($white & (1 << $mw)) == 0) && (($black & (1 << $mw)) == 0) ) {
my $pw = $white | (1 << $mw);
#
# white wins, take it!
return $mw if ( $won[$pw] );
for ( my $mb = 0; $mb < 9; $mb++ ) {
if ( (($pw & (1 << $mb)) == 0) && (($black & (1 << $mb)) == 0) ) {
my $pb = $black | (1 << $mb);
#
# black wins, take another
goto outerLoop if ( $won[$pb] );
}
}
# Neither white nor black can win in one move, this will do.
$bestmove = $mw if ($bestmove == -1);
}
outerLoop:
}
return $bestmove if ( $bestmove != -1 );
# No move is totally satisfactory, try the first one that is open
for ( my $i = 0; $i < 9; $i++ ) {
my $mw = $moves[$i];
return $mw if ( (($white & (1 << $mw)) == 0) && (($black & (1 << $mw)) == 0) );
}
# No more moves
-1;
}
##
# User move.
# @return true if legal
#
sub yourMove
{
my $m = $_[0]->getIntegerField ( 'Coordinate' );
# print " O's move is $m\n";
return $false if ( ($m < 0) || ($m > 8) );
return $false if ( (($black | $white) & (1 << $m)) != 0 );
$black |= 1 << $m;
$true;
}
##
# Computer move.
# @return true if legal
#
sub myMove
{
return $false if ( ($black | $white) == $DONE );
my $best = bestMove ( $white, $black );
$white |= 1 << $best;
# print " X's move is $best\n";
$staticBoard [ $best ] = 'O'; # client script hack
$best;
}
sub setBoard
{
my $e = shift;
my $i = 0;
my %hash = $e->toHash;
my @board;
if ( exists($hash{Board}) ) {
#
# we are playing against Apache
#
@board = @{ $hash{Board} };
}
else {
#
# we are playing against a client script
#
$staticBoard [ $hash{Coordinate} ] = 'X';
@board = @staticBoard;
}
foreach my $m (@board) {
if ( $m eq "X" ) {
$black |= 1 << $i;
} elsif ( $m eq "O" ) {
$white |= 1 << $i;
}
$i++;
}
}
##
# Figure what the status of the game is.
#
sub status
{
return $WIN if ( $won[$white] );
return $LOSE if ( $won[$black] );
return $STALEMATE if ( ($black | $white) == $DONE );
$OK;
}
sub startup
{
my $self = shift;
# subscribe to TicTacToe events:
return $false if ( $self->newSubscription ( $tttEvent, 0 ) );
return $false if ( $self->newSubscription ( $tttEventRequest, 0 ) );
# register the event
$self->addEvent( new Aw::EventType ( $tttEvent ) );
$self->addEvent( new Aw::EventType ( $tttEventRequest ) );
( $self->initStatusSubscriptions ) ? $false : $true ; # init also does publishStatus
}
sub processRequest
{
my ($self, $requestEvent, $eventDef) = @_;
# print $requestEvent->toString;
my $eventTypeName = $requestEvent->getTypeName;
$move ||= $self->createEvent ( $tttEvent );
$black = $white = 0;
if ( $eventTypeName eq $tttEventRequest ) {
$self->deliverAckReplyEvent;
resetStaticBoard;
}
elsif ( $eventTypeName eq $tttEvent ) {
setBoard ( $requestEvent );
$move->setIntegerField ( 'Coordinate', myMove );
$self->deliverReplyEvent ( $move );
}
print "Waiting for O's move...\n";
$true;
}
package main;
main: {
my %properties = (
clientId => "TicTacToe Adapter",
# broker => 'test_broker@localhost:6449',
broker => $ARGV[0],
adapterId => 0,
debug => 0,
clientGroup => "PerlDemoAdapter",
adapterType => "ttt_adapter",
);
# Start with one step...
#
my $adapter = new TicTacToeAdapter ( \%properties );
$adapter->init;
my $retVal = 0;
# process connection testing mode
#
die ( "\n$retVal = ", $adapter->connectTest, "\n" )
if ( $adapter->isConnectTest );
if ( $adapter->createClient ) {
# we don't want to go here.
$retVal = 1;
} else {
# we want to go here
$retVal = $adapter->startup;
my $test = $adapter->getEvents;
$retVal = 1 if ($retVal && $adapter->getEvents);
}
print "\nRetval = $retVal\n";
}
__END__
/*
* @(#)TicTacToe.java 1.4 98/06/29
*
* Copyright (c) 1997, 1998 Sun Microsystems, Inc. All Rights Reserved.
*
* Sun grants you ("Licensee") a non-exclusive, royalty free, license to use,
* modify and redistribute this software in source and binary code form,
* provided that i) this copyright notice and license appear on all copies of
* the software; and ii) Licensee does not utilize the software in a manner
* which is disparaging to Sun.
*
* This software is provided "AS IS," without a warranty of any kind. ALL
* EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, INCLUDING ANY
* IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR
* NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN AND ITS LICENSORS SHALL NOT BE
* LIABLE FOR ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING
* OR DISTRIBUTING THE SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN OR ITS
* LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR FOR DIRECT,
* INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE DAMAGES, HOWEVER
* CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, ARISING OUT OF THE USE OF
* OR INABILITY TO USE SOFTWARE, EVEN IF SUN HAS BEEN ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGES.
*
* This software is not designed or intended for use in on-line control of
* aircraft, air traffic, aircraft navigation or aircraft communications; or in
* the design, construction, operation or maintenance of any nuclear
* facility. Licensee represents and warrants that it will not use or
* redistribute the Software for such purposes.
*/
/**
* A TicTacToe applet. A very simple, and mostly brain-dead
* implementation of your favorite game! <p>
*
* In this game a position is represented by a white and black
* bitmask. A bit is set if a position is ocupied. There are
* 9 squares so there are 1<<9 possible positions for each
* side. An array of 1<<9 booleans is created, it marks
* all the winning positions.
*
* @version 1.2, 13 Oct 1995
* @author Arthur van Hoff
* @modified 04/23/96 Jim Hagen : winning sounds
* @modified 02/10/98 Mike McCloskey : added destroy()
*/
=head1 NAME
ttt_adapter.pl - A TicTacToe Adapter for ActiveWorks Brokers.
=head1 SYNOPSIS
./ttt_adapter.pl MyBroker@MyHost:1234
=head1 DESCRIPTION
The TicTacToe adapter is based loosely on the Java applet by
Arthur van Hoff. The adapter will play against the mod_perl
client found in bin/apache/site_perl/Apache/Toe.pm. The adapter
can also play against the ttt_client.pl client script.
=head1 AUTHOR
Daniel Yacob Mekonnen, L<Yacob@wMUsers.Com|mailto:Yacob@wMUsers.Com>
=head1 SEE ALSO
S<perl(1). ActiveWorks Supplied Documentation>
=cut