program hex;
{*game of Hex, see Summer 1995 issue of Mathematical Intelligencer*}
{* player  1  is 'X', trying to go across; 2 is 'O', trying to go up/down *}
{*directions are 1=NE, 2=E, 3=SE, 4=SW, 5=W, 6=NW*}

const MAXSIZE=13; {* any  larger and you mess up display *}

var i,j: integer;
	numrows,numcols,spotsleft,playr,lasti,lastj,laststate:integer;
	state: array[1..MAXSIZE,1..MAXSIZE] of integer;
	bigsize:boolean;

function isin(i,j:integer):boolean;
var temp:boolean;
begin
temp:=TRUE;
if (i<1) or (i>numcols) or (j<1) or (j>numrows) then temp:=FALSE;
isin:=temp;
end;

procedure gotxy(i,j:integer);
begin
gotoxy(i+25-j,j); {*or of course gotoxy would work!*}
end;

procedure gotocell(i,j:integer);
begin
if not bigsize then gotxy(6*i-2,3*j-2);
if bigsize then gotxy(4*i-2, 2*j-1);
end;

procedure makeone(i,j:integer);
{*draw a cell at location i,j with lines going down or right from it*}
begin
if not bigsize then begin
	gotxy(i,j+0);write('  ----');
	gotxy(i,j+1);write(' / \  ');
	gotxy(i,j+2);write(' /   \');
	end;
if bigsize then begin
	gotxy(i,j+0);write('  --');
	gotxy(i,j+1);write(' /\ ');
	end;
end;

procedure makeright(i,j:integer);
begin
gotxy(i,j+0);write('  ');
gotxy(i,j+1);write(' /');
if not bigsize then begin gotxy(i,j+2);write(' /');end;
end;

procedure makebot(i,j:integer);
begin
if not bigsize then begin gotxy(i,j);write('  ----'); end;
if bigsize then begin gotxy(i,j);write('  --');end;
end;

procedure makecorner(i,j:integer);
begin
gotxy(i,j);write('  ');
end;

procedure moveit(i,j,d:integer; var ip,jp:integer);
begin
      if d=1 then begin ip:=i; jp:=j-1; end;
      if d=2 then begin ip:=i+1;jp:=j; end;
      if d=3 then begin ip:=i+1; jp:=j+1; end;
      if d=4 then begin ip:=i; jp:=j+1; end;
      if d=5 then begin ip:=i-1; jp:=j; end;
      if d=6 then begin ip:=i-1; jp:=j-1; end;
end;

procedure findnext(var i,j,direct:integer);
{*look for next  X  (=1)  on boundary of block of  X's *}
var ip,jp,d: integer;
begin
{*gotocell(i,j);write('**');*}
d:=((direct+3)+1) mod 6; {*direct+3 = direction opposite 'direct'*}
ip:=0; jp:=0;
while NOT (isin(ip,jp) and (state[ip,jp]=1) ) do begin
      d:=(d+1) mod 6;
      if d=0 then d:=6;
      moveit(i,j,d,ip,jp);
      end;
i:=ip; j:=jp; direct:=d;
end;

function Xreaches(var j:integer):boolean;
{*See if the '1' at cell (1,j) connects to RHS*}
{*Note: end with  (1,j)=last cell in this boundary*}
var direct:integer;
begin
{*Try following 'outermost' path: leave cells along first possible edge
(clockwise) from one used to enter -- may be same edge.*}
	{*gotocell(1,j);write('**');*}
	direct:=0;
	if (j<numrows) and (state[2,j+1]=1) then direct:=3;
	if state[2,j]=1 then direct:=2;
	i:=2;
	if direct=3 then j:=j+1;
{*now unless direct=0, there is a 1 in (i,j), @ direction 'direct'*}
	if direct>0 then while (i>1) and (i<numcols) do findnext(i,j,direct);
	if i=numcols then Xreaches:=TRUE else Xreaches:=FALSE;
end;

function Xwins:boolean;  {*Look to see if  X (player 1) won *}
var temp:boolean; direct:integer;
begin
temp:=FALSE;
{*first find a row where an X appears in column 1*}
j:=1;
while (j<=numrows) and (not temp) do begin
	while (j<=numrows) and (state[1,j]<>1) do j:=j+1;
	if state[1,j]=1 then if Xreaches(j) then temp:=TRUE;
	j:=j+1;
	end;
Xwins:=temp;
end;

function Owins:boolean;  {*Look to see if  O (player 2) won *}
var temp:boolean; direct:integer;
begin
temp:=FALSE;
{*first find a column where an O appears in row 1*}
{*
i:=1;
while (i<=numrows) and (not temp) do begin
	while (i<=numrows) and (state[i,1]<>2) do i:=i+1;
	if state[i,1]=2 then if Xreaches(j) then temp:=TRUE;
	j:=j+1;
	end;
Xwins:=temp;
*}
end;

function nextspot:integer;
var ch:char;d:integer;
begin
d:=-1;
while d<0 do begin
	read(kbd,ch);
	if ch='9' then d:=1;
	if ch='6' then d:=2;
	if ch='3' then d:=3;
	if ch='1' then d:=4;
	if ch='4' then d:=5;
	if ch='7' then d:=6;
	if ch='5' then d:=0;
	if ch='q' then begin spotsleft:=0;d:=0;end;
	end;
nextspot:=d;
end;

procedure onemove;
var d,ip,jp: integer;
begin
d:=nextspot;
if (d=0) and (laststate=0) then begin {*player wants that spot*}
	state[lasti,lastj]:=playr;
	if playr=1 then begin gotocell(lasti,lastj);write('><');end;
	if playr=2 then begin gotocell(lasti,lastj);write('()');end;
	laststate:=playr;
	spotsleft:=spotsleft-1;
	playr:=3-playr;
	gotoxy(14,8);if playr=1 then write('X') else write('O');
	gotocell(lasti,lastj);
	end;
if d>0 then moveit(lasti,lastj,d,ip,jp); {*compute where s/he wants to go*}
if (d>0) and isin(ip,jp) then begin
	if laststate=0 then begin gotocell(lasti,lastj);write('  ');end;
	if laststate=1 then begin gotocell(lasti,lastj);write('><');end;
	if laststate=2 then begin gotocell(lasti,lastj);write('()');end;
	lasti:=ip;lastj:=jp;laststate:=state[ip,jp];
	gotocell(lasti,lastj);write('%%');
	end;
end;

procedure initialize;
begin
ClrScr;
writeln('This is a computer version of the game HEX. For a general discussion, see');
writeln('the Summer 1995 issue of the Mathematical Intelligencer.');writeln;
writeln('This adaption by Dave Rusin, 7/7/95');writeln;
writeln('Two players alternate turns placing markers on a honeycomb grid;');
writeln('the first one to form an unbroken chain in their direction wins.');
write('How many rows would you like? (up to ',MAXSIZE,') ');
readln(numrows);
write('How many columns would you like? (up to ',MAXSIZE,') ');
readln(numcols);
if (numrows>8) or (numcols>8) then bigsize:=TRUE else bigsize:=FALSE;
ClrScr;
writeln('First Player (X) tries');
writeln('to go left and right.');
writeln;
writeln('Second player (O)');
writeln('goes up/down');
gotoxy(62,17);write('Hit NUMLOCK!');
gotoxy(60,19);write('Arrow keys move');
gotoxy(59,20);write('(1,4,7,9,6,3 only)');
gotoxy(57,22);write('Hit  5  to take cell');
gotoxy(55,24);write('Hit  q  to quit.');
gotoxy(1,8);write('Next play by X');
if not bigsize then for j:=1 to numrows-1 do begin
	for i:=1 to numcols-1 do makeone(6*i-2,3*j-2);
	makeright(6*numcols-2,3*j-2);
	end;
if bigsize then for j:=1 to numrows-1 do begin
	for i:=1 to numcols-1 do makeone(4*i-2,2*j-1);
	makeright(4*numcols-2,2*j-1);
	end;
if not bigsize then for i:=1 to numcols-1 do makebot(6*i-2,3*numrows-2);
if bigsize then for i:=1 to numcols-1 do makebot(4*i-2,2*numrows-1);
if not bigsize then makecorner(6*numcols-2,3*numrows-2);
if bigsize then makecorner(4*numcols-2,2*numrows-1);
lowvideo;
for i:=1 to numcols do for j:=1 to numrows do state[i,j]:=0;
spotsleft:=numrows*numcols;
playr:=1;
lasti:=1;lastj:=1;laststate:=0;
end;

{******CODE FOR MAIN LOOP********}
begin
initialize;
gotocell(1,1);write('%%');
while spotsleft>0 do onemove;
gotoxy(1,10);
if Xwins then writeln('Player 1 won.');
{*if Owins then writeln('Player 2 won.');*}
gotoxy(1,24);
end.