WONGR@MSVU.BITNET (E.T. RALPH) (02/03/90)
-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X Weight`0911,1`093:=10;`009Weight`0918,1`093:=10;
X Weight`0911,8`093:=10;`009Weight`0918,8`093:=10;
X Weight`0912,2`093:=-4;`009Weight`0917,2`093:=-4;
X Weight`0912,7`093:=-4;`009Weight`0917,7`093:=-4;
X Delta`0911`093.X:=0;`009Delta`0911`093.Y:=-1;
X Delta`0912`093.X:=1;`009Delta`0912`093.Y:=-1;
X Delta`0913`093.X:=1;`009Delta`0913`093.Y:=0;
X Delta`0914`093.X:=1;`009Delta`0914`093.Y:=1;
X Delta`0915`093.X:=0;`009Delta`0915`093.Y:=1;
X Delta`0916`093.X:=-1;`009Delta`0916`093.Y:=1;
X Delta`0917`093.X:=-1;`009Delta`0917`093.Y:=0;
X Delta`0918`093.X:=-1;`009Delta`0918`093.Y:=-1;
XEND;
X
XPROCEDURE DisplayTime;
XVAR
X DateString, TimeString: PACKED ARRAY`0911..11`093 OF CHAR;
X Month: PACKED ARRAY`0911..3`093 OF CHAR;
X Year, Day, Hours, Mins: INTEGER;
X AMPM: CHAR;
X I: INTEGER;
XBEGIN
X DATE(DateString);
X TIME(TimeString);
X Day:=(ORD(DateString`0911`093)-48)*10+ORD(DateString`0912`093)-48;
X Month:=DateString`0914`093+CHR(ORD(DateString`0915`093)+32)+CHR(ORD(DateSt
Vring`0916`093)+32);
X Year:=0;
X FOR I:=8 TO 11 DO
X Year:=Year*10+ORD(DateString`091I`093)-48;
X Hours:=(ORD(TimeString`0911`093)-48)*10+ORD(TimeString`0912`093)-48;
X Mins:=(ORD(TimeString`0914`093)-48)*10+ORD(TimeString`0915`093)-48;
X IF Hours<12 THEN
X AMPM:='a'
X ELSE
X AMPM:='p';
X IF Hours>12 THEN
X Hours:=Hours-12
X ELSE IF Hours=0 THEN
X Hours:=12;
X Position(1,24);
X WRITE('* The time is now ',Hours:1,':');
X IF Mins<10 THEN WRITE('0');
X WRITE(Mins:1,' ',AMPM:1,'m. Today is ',Month:3);
X IF Month<>'May' THEN WRITE('.');
X WRITE(' ',Day:1,', ',Year:1,'. *');
XEND;
X
XFUNCTION Opposite(Piece: PieceType): PieceType;
XBEGIN
X IF Piece=BLACK THEN Opposite:=WHITE
X ELSE IF Piece=WHITE THEN Opposite:=BLACK
X ELSE Opposite:=PIECE;
XEND;
X
XFUNCTION InBounds(Dimension: INTEGER): BOOLEAN;
XBEGIN
X InBounds:=((Dimension>=1) AND (Dimension<=8));
XEND;
X
XFUNCTION CountFlips(VAR Board: BoardType; Player: PieceType; X,Y: INTEGER;
X VAR Count: CountType): INTEGER;
XVAR Total,Dir: INTEGER;
X
X FUNCTION CountInDir(VAR Board: BoardType; Player: PieceType;
X X,Y,DeltaX,DeltaY: INTEGER): INTEGER;
X VAR
X Total: INTEGER;
X TX,TY: INTEGER;
X Resolved: BOOLEAN;
X BEGIN
X Total:=0;
X TX:=X;
X TY:=Y;
X REPEAT
X Resolved:=TRUE;
X TX:=TX+Delta`091Dir`093.X;
X TY:=TY+Delta`091Dir`093.Y;
X IF NOT (InBounds(TX) AND InBounds(TY)) THEN
X Total:=0
X ELSE IF Board`091TX,TY`093=BLANK THEN
X Total:=0
X ELSE IF Board`091TX,TY`093<>Player THEN
X BEGIN
X Total:=Total+1;
X Resolved:=FALSE;
X END;
X UNTIL Resolved;
X CountInDir:=Total;
X END;
X
XBEGIN
X Total:=0;
X FOR Dir:=1 TO 8 DO
X BEGIN
X Count`091Dir`093:=CountInDir(Board,Player,X,Y,Delta`091Dir`093.X,Delta`0
V91Dir`093.Y);
X Total:=Total+Count`091Dir`093;
X END;
X CountFlips:=Total;
XEND;
X
XFUNCTION NumberFlips(Count: CountType): INTEGER;
XVAR Total,I: INTEGER;
XBEGIN
X Total:=0;
X FOR I:=1 TO 8 DO Total:=Total+Count`091I`093;
X NumberFlips:=Total;
XEND;
X
XFUNCTION Blocked(VAR Board: BoardType; Player: PieceType): BOOLEAN;
XLABEL 100;
XVAR
X X,Y: INTEGER;
X Count: CountType;
XBEGIN
X Blocked:=TRUE;
X FOR X:=1 TO 8 DO
X FOR Y:=1 TO 8 DO
X IF Board`091X,Y`093=BLANK THEN
X BEGIN
X CountFlips(Board,Player,X,Y,Count);
X IF NumberFlips(Count)<>0 THEN
X BEGIN
X Blocked:=FALSE;
X GOTO 100;
X END;
X END;
X 100: `123To abort the nested loop`125
XEND;
X
XPROCEDURE PerformFlips(VAR Board: BoardType; VAR Score: ScoreType;
X Player: PieceType; X,Y: INTEGER; Count: CountType);
XVAR Dir,I: INTEGER;
XBEGIN
X Board`091X,Y`093:=Player;
X Score`091Player`093:=Score`091Player`093+1;
X FOR Dir:=1 TO 8 DO
X FOR I:=1 TO Count`091Dir`093 DO
X BEGIN
X Board`091X+Delta`091Dir`093.X*I,Y+Delta`091Dir`093.Y*I`093:=Player;
X Score`091Player`093:=Score`091Player`093+1;
X Score`091Opposite(Player)`093:=Score`091Opposite(Player)`093-1;
X END;
XEND;
X
XPROCEDURE ShowFlips(Player: PieceType; X,Y: INTEGER; Count: CountType);
XVAR Dir,I: INTEGER;
XBEGIN
X DisplaySquare(Player,X,Y);
X FOR Dir:=1 TO 8 DO
X FOR I:=1 TO Count`091Dir`093 DO
X DisplaySquare(Player,X+Delta`091Dir`093.X*I,Y+Delta`091Dir`093.Y*I);
XEND;
X
XFUNCTION SelectBest(VAR Board: BoardType; Score: ScoreType; Player: PieceTyp
Ve;
X Depth: INTEGER; VAR MoveX, MoveY: INTEGER): INTEGER;
XLABEL 200;
XVAR
X High,Pos,MoveScore,
X X,Y,DumX,DumY: INTEGER;
X BestMove: ARRAY`0911..64`093 OF CoordType;
X Count: CountType;
X HypScore: ScoreType;
X HypPlayer: PieceType;
XBEGIN
X High:=-MAXINT;
X Pos:=0;
X MoveScore:=0;
X FOR X:=1 TO 8 DO
X FOR Y:=1 TO 8 DO
X IF Board`091X,Y`093=BLANK THEN
X BEGIN
X MoveScore:=CountFlips(Board,Player,X,Y,Count);
X IF MoveScore>0 THEN
X BEGIN
X IF (Score`091WHITE`093+Score`091BLACK`093+Depth<60) THEN
X MoveScore:=MoveScore+Weight`091X,Y`093;
X IF Depth<=1 THEN GOTO 200;
X HypBoard`091Depth`093:=Board;
X HypScore:=Score;
X PerformFlips(HypBoard`091Depth`093,HypScore,Player,X,Y,Count);
X HypPlayer:=OPPOSITE(Player);
X IF Blocked(HypBoard`091Depth`093,HypPlayer) THEN
X BEGIN
X IF Blocked(HypBoard`091Depth`093,Player) THEN GOTO 200;
X MoveScore:=MoveScore + SelectBest(HypBoard`091Depth`093,HypScore
V,
X`009`009`009Player,Depth-1,DumX,DumY);
X END
X ELSE MoveScore:=MoveScore - SelectBest(HypBoard`091Depth`093,HypSc
Vore,
X`009`009`009HypPlayer,Depth-1,DumX,DumY);
X200: IF MoveScore>High THEN
X BEGIN
X Pos:=0;
X High:=MoveScore;
X END;
X IF MoveScore=High THEN
X BEGIN
X Pos:=Pos+1;
X BestMove`091Pos`093.X:=X;
X BestMove`091Pos`093.Y:=Y;
X END;
X END;
X END;
X Pos:=Random(Pos);
X MoveX:=BestMove`091Pos`093.X;
X MoveY:=BestMove`091Pos`093.Y;
X SelectBest:=High;
XEND;
X
XPROCEDURE ComputerMove(VAR X,Y: INTEGER; VAR Count: CountType;
X VAR Stop: BOOLEAN);
XBEGIN
X Position(1,21);
X WRITELN('Thinking....');
X SelectBest(Board,Score,Player,Depth,X,Y);
X CountFlips(Board,Player,X,Y,Count);
X ClearBottom;
X IF (Board`091X,Y`093<>BLANK) OR (NumberFlips(Count)=0) THEN
X BEGIN
X Message(BELL+'Something is wrong with the computer opponent!!');
X Stop:=TRUE;
X END;
X CASE X OF
X 1: IF Y=1 THEN Weight`0911,1`093:=1
X ELSE IF Y=8 THEN Weight`0911,8`093:=1;
X 8: IF Y=1 THEN Weight`0918,1`093:=1
X ELSE IF Y=8 THEN Weight`0918,8`093:=1;
X END;
XEND;
X
XPROCEDURE HumanMove(VAR X,Y: INTEGER; VAR Count: CountType; VAR Stop: BOOLEA
VN);
XVAR
X MakeMove: BOOLEAN;
X Str: String;
X I,J: INTEGER;
XBEGIN
X MakeMove:=FALSE;
X Stop:=FALSE;
X REPEAT
X Position(1,21);
X WRITE('Your move > ');
X READLN(Str);
X ClearBottom;
X J:=0;
X FOR I:=1 TO LENGTH(Str) DO
X BEGIN
X J:=J+1;
X IF (Str`091I`093>='A') AND (Str`091I`093<='Z') THEN
X Str`091J`093:=CHR(ORD(Str`091I`093)+32)
X ELSE IF Str`091I`093 IN `091' ','=',','`093 THEN
X J:=J-1
X ELSE
X Str`091J`093:=Str`091I`093;
X END;
X Str.Length:=J;
X IF (Str='exit') OR (Str='quit') THEN
X Stop:=TRUE
X ELSE IF (Str='time') THEN
X DisplayTime
X ELSE IF Str='human' THEN
X BEGIN
X Mind`091WHITE`093:=HUMAN;
X Mind`091BLACK`093:=HUMAN;
X Message('OK: Computer player removed.');
X END
X ELSE IF (Str='compblack') OR (Str='computerblack') THEN
X BEGIN
X Mind`091WHITE`093:=HUMAN;
X Mind`091BLACK`093:=COMPUTER;
X Message('OK: Computer is now playing Black.');
X IF Player=BLACK THEN
X BEGIN
X MakeMove:=TRUE;
X ComputerMove(X,Y,Count,Stop);
X END;
X END
X ELSE IF (Str='compwhite') OR (Str='computerwhite') THEN
X BEGIN
X Mind`091WHITE`093:=COMPUTER;
X Mind`091BLACK`093:=HUMAN;
X Message('OK: Computer is now playing White.');
X IF Player=WHITE THEN
X BEGIN
X MakeMove:=TRUE;
X ComputerMove(X,Y,Count,Stop);
X END;
X END
X ELSE IF (Str='autopilot') THEN
X BEGIN
X Mind`091WHITE`093:=COMPUTER;
X Mind`091BLACK`093:=COMPUTER;
X Message('Automatic pilot.....!');
X MakeMove:=TRUE;
X ComputerMove(X,Y,Count,Stop);
X END
X ELSE IF LENGTH(Str)>=5 THEN
X BEGIN
X IF SUBSTR(Str,1,5)='depth' THEN
X IF (LENGTH(Str)=5) THEN
X BEGIN
X Position(1,24);
X WRITE('* The computer is currently at depth level ',Depth:1,'. *')
V;
X END
X ELSE IF (LENGTH(Str)>6) OR (Str`0916`093<'1') OR (Str`0916`093>'5')
V THEN
X Message('I ain''t that deep!')
X ELSE
X BEGIN
X Depth:=ORD(Str`0916`093)-48;
X Position(1,24);
X WRITE('* OK: the computer is now at depth level ',Depth:1,'. *');
X END;
X END
X ELSE IF LENGTH(Str)=2 THEN
X BEGIN
X X:=0; Y:=0;
X FOR I:=1 TO 2 DO
X IF (Str`091I`093>='a') AND (Str`091I`093<='h') THEN X:=ORD(Str`091I`
V093)-96
X ELSE IF (Str`091I`093>='1') AND (Str`091I`093<='8') THEN Y:=ORD(Str`
V091I`093)-48;
X IF (X=0) OR (Y=0) THEN
X Message('That is not a square on the board.')
X ELSE IF Board`091X,Y`093<>BLANK THEN
X Message('That''s not a blank square.')
X ELSE IF CountFlips(Board,Player,X,Y,Count)=0 THEN
X Message('You must flip over at least one piece.')
X ELSE MakeMove:=TRUE;
X END
X ELSE IF LENGTH(Str)<>0 THEN
X Message('Type in the coordinates of the square -- a letter and a numbe
Vr.')
X UNTIL MakeMove OR Stop;
XEND;
X
X
XBEGIN
X SetUp(Board,Score,Player);
X Stop:=FALSE;
X REPEAT
X ShowTurn(Score,Player);
X IF Blocked(Board,Player) THEN
X BEGIN
X Player:=Opposite(Player);
X IF Blocked(Board,Player) THEN
X BEGIN
X Message(BELL+'Neither player has a legal move.');
X Stop:=TRUE;
X END
X ELSE Message(BELL+'Your opponent cannot move: Go again.');
X END
X ELSE
X BEGIN
X IF Mind`091Player`093=HUMAN THEN
X HumanMove(X,Y,Count,Stop)
X ELSE
X ComputerMove(X,Y,Count,Stop);
X IF NOT Stop THEN
X BEGIN
X PerformFlips(Board,Score,Player,X,Y,Count);
X ShowFlips(Player,X,Y,Count);
X Player:=Opposite(Player);
X Stop:=(Score`091WHITE`093+Score`091BLACK`093=64);
X END;
X END;
X UNTIL Stop;
X
X100:
X ShowWinner(Score);
X Position(4,22);
X WRITELN;
XEND.
$ CALL UNPACK REVERSI2.PAS;1 1611807794
$ v=f$verify(v)
$ EXIT