othellov pascal

[sean brennan]

program othello(kybd,output,boardfile);
{Sean Brennan 12/19?/89 this is my first AI SPB109}

type
boardstate=-1..1;
gameboard=array[1..8,1..8] of boardstate;
boardvalue=array[1..8,1..8] of integer;
ynboard=array[1..8,1..8] of boolean;
var
kybd,boardfile:text;
board:gameboard;
priority:boardvalue;
compblue:boolean;

procedure setup;
var
loopx,loopy,temp:integer;
ch:char;

begin
reset(boardfile,'name=othello.data.a1');
for loopy:=1 to 8 do
begin
for loopx:=1 to 8 do
begin
readln(boardfile,temp);
write(temp:3);
priority[loopx,loopy]:=temp;
end;
writeln;
end;
board[4,4]:=1;
board[4,5]:=-1;
board[5,4]:=-1;
board[5,5]:=1;
writeln('Compuer playing X for you');
read(kybd,ch);
compblue:=(ch<>'n');
close(boardfile);
end;
procedure redraw;
var
loopx,loopy:integer;

begin
writeln(' A B C D E F G H ');
for loopy:=1 to 8 do
begin
write(loopy:1);
for loopx:=1 to 8 do
begin
case board[loopx,loopy] of
-1:write(' O ');
1:write(' X ');
0:write(' + ');
end;
end;
writeln;
end;
write(' A B C D E F G H ');
end;
function walk(plyr,xdr,ydr,x,y:integer):boolean;
var
bstate,dx,dy,negplyr:integer;

begin
dx:=x+xdr;
dy:=y+ydr;
negplyr:=0-plyr;
if (((dx=0) or (dx=9)) or ((dy=0) or(dy=9))) then bstate:=plyr
else bstate:=board[dx,dy];
if not(bstate=negplyr) then
walk:=false
else
begin
x:=x+xdr;
y:=y+ydr;
repeat
x:=x+xdr;
y:=y+ydr;
if (x>8) or (x<1) or (y>8) or (y<1) then
x:=0;
if x<>0 then
if board[x,y]=0 then x:=0;
until (x=0) or (board[x,y]=plyr);
if x=0 then walk:=false
else walk:=true;
end;
end;

function check(plyr,xpos,ypos:integer):boolean;
var
overall:boolean;
xl,yl:integer;
begin
overall:=false;
for xl:=-1 to 1 do
for yl:=-1 to 1 do
if not ((xl=0) and (yl=0)) then
overall:=overall or walk(plyr,xl,yl,xpos,ypos);

check:=overall;
end;

procedure wherecanmove (player:integer ;
var canmove:boolean;var wcm:ynboard);
var
temp,loopx,loopy:integer;
yn:boolean;
begin
canmove:=false;
for loopx:=1 to 8 do
begin
for loopy:=1 to 8 do
begin
temp:=board[loopx,loopy];
if not (temp=0) then
wcm[loopx,loopy]:=false
else
begin
yn:=check(player,loopx,loopy);
wcm[loopx,loopy]:=yn;
if yn=true then canmove:=true;
end;
end;
end;
end;

procedure conquor(plyr,xpos,ypos:integer;var aboard:gameboard);
procedure flip(xdr,ydr,x,y:integer);
var
xh,yh:integer;
untilcheck:boolean;
begin
xh:=x;
yh:=y;
if not(((x+xdr) in [0,9]) or ((y+ydr) in [0,9]))then
if aboard[(x+xdr),(y+ydr)]=-plyr then
begin
x:=x+xdr;
y:=y+ydr;
repeat
x:=x+xdr;
y:=y+ydr;
if (x>8) or (x<1) or (y>8) or (y<1) then
x:=0;
untilcheck:=false;
if x<>0 then
begin
untilcheck:=(aboard[x,y]=plyr);
if aboard[x,y]=0 then x:=0;
end;
until (x=0) or (untilcheck);
if x<>0 then
repeat
xh:=xh+xdr;
yh:=yh+ydr;
if aboard[xh,yh]<>plyr then
aboard[xh,yh]:=plyr
else
xh:=0;
until (xh=0);
end;
end;
var
xl,yl:integer;
begin
for xl:=-1 to 1 do
for yl:=-1 to 1 do
if not ((xl=0) and (yl=0)) then
flip(xl,yl,xpos,ypos);

end;
function howgoodisit(plyr,x,y:integer;ficbrd:gameboard):integer;
var
xlop,ylop,sum:integer;
begin
sum:=0;
conquor(plyr,x,y,ficbrd);
for xlop:=1 to 8 do
for ylop:=1 to 8 do
if ficbrd[xlop,ylop]=plyr then
sum:=sum+priority[xlop,ylop];
{ sum:=sum+priority[xlop,ylop]*5;}
howgoodisit:=sum;
end;

Procedure findbestmove(player:integer;var legalplace:ynboard);
var
loopx,loopy,x,y,good,temp:integer;
begin
good:=0;
for loopx:=1 to 8 do
for loopy:=1 to 8 do
if legalplace[loopx,loopy]=true then
begin
temp:=howgoodisit(player,loopx,loopy,board);
if (good<temp) or ((good=temp) and (random(2)>1))
then
begin
good:=temp;
x:=loopx;
y:=loopy;
end;
end;
conquor(player,x,y,board);
board[x,y]:=player;
end;

procedure moveit(player:integer;var legalplace:ynboard);
var
x,y:integer;
ch:char;
begin
x:=1;
y:=1;
repeat
writeln('Enter Letter (caps) or S to see board');
readln(kybd,ch);
if ch='S' then redraw;
x:=ord(ch)-ord('A')+1;
if ((ch<>'S') and (ch in ['A'..'H'])) then
BEGIN
writeln('And the number:');
readln(kybd,y);
END
else
begin
x:=1;
y:=1;
end;
until (legalplace[x,y]=true)AND (CH IN ['A'..'H']);
board[x,y]:=player;
conquor(player,x,y,board);
end;

procedure play;
var
loop,sum:integer;
redpass,bluepass,done,canmove:boolean;
placeavail:ynboard;
begin
repeat
redpass:=false;
bluepass:=false;
writeln('It is X''s turn. ');
wherecanmove(1,canmove,placeavail);
if canmove=true then
if (compblue=true) then
findbestmove(1,placeavail)
else
moveit(1,placeavail)
else
begin
bluepass:=true;
end;
redraw;

writeln('It is O''s turn. ');
wherecanmove(-1,canmove,placeavail);
if canmove=true then
moveit(-1,placeavail)
else
begin
redpass:=true;
writeln('Red must pass. ');
end;
redraw;
done:=redpass and bluepass;
until (done=true);
sum:=0;
for loop:=1 to 64 do
sum:=sum+board[(((loop-1) div 8)+1),((loop mod 8)+1)];
sum:=abs(sum);
if sum>0 then writeln('O is the winner by ',sum:2,' pieces!')
else if sum<0 then writeln('X is the winner by ',sum:2,' pieces!')
else write('How boring. A tie.');
end;

procedure newgame;
var
ch:char;
begin
repeat
setup;
redraw;
play;
writeln('Play another?');
read(kybd,ch);
until (ch='n') or (ch='N');
end;

begin
termin(kybd);
termout(output);
newgame;
end.