—#!/usr/bin/perl -w
$| =1;
package
TicTacToeAdapter;
use
Aw;
use
Aw::Event;
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
);
}
"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);
}
"\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