Hanoi Towers

program lab_1_1_3;
{
  This program solves the Tower of Hanoi puzzle
  Matyushin Vyacheslav    (group 07-PO1)
}

const N = 10;
	 
type
	 circle_array	= array [1..N] of Integer;


procedure PrintArray (a	: circle_array);
var
	 i : Integer;
begin	
	 for i := 1 to N do
			Write (a[i],' ');
	 Writeln;
end; { PrintArray }


procedure PrintArrays (a, b, c : circle_array);
begin
	 Write ('A: ');
	 PrintArray (a);
	 Write ('B: ');
	 PrintArray (b);
	 Write ('C: ');
	 PrintArray (c);
	 Writeln;
end; { PrintArrays }


function ArrayIsEmpty (a : circle_array) : boolean;
var
	 i, flag	: Integer;
begin
	 flag := 0;
	 for i := 1 to N do
	 begin
			if a[i] <> 0 then
			begin
				 flag := 1;
				 break;
			end;
	 end;
	 if flag = 0 then
			ArrayIsEmpty := true
	 else
			ArrayIsEmpty := false;
end; { ArrayIsEmpty }


function ArrayHeigth (a	: circle_array) : Integer;
var
	 i, flag : Integer;
begin
	 flag := 0;
	 if ArrayIsEmpty (a) then
			ArrayHeigth := 0
	 else
	 begin
			for i := 1 to N do
				 if a[i] = 0 then
				 begin
						ArrayHeigth := i - 1;
						flag := 1;
						break;
				 end;
			if flag = 0 then
				 ArrayHeigth := N;
	 end;
end; { ArrayHeigth }


procedure Swap (var a, b : circle_array);
var ha, hb : Integer;
begin
	 ha := ArrayHeigth (a);
	 hb := ArrayHeigth (b);

	 if (ha = 0) and (hb <> 0) then
	 begin
			a[1] := b[hb];
			b[hb] := 0;
	 end;

	 if (hb = 0) and (ha <> 0) then
	 begin
			b[1] := a[ha];
			a[ha] := 0;
	 end;
	 
	 if a[ha] < b[hb] then
	 begin
			b[hb + 1] := a[ha];
			a[ha] := 0;
	 end;
	 
	 if b[hb] < a[ha] then
	 begin
			a[ha + 1] := b[hb];
			b[hb] := 0;
	 end;
end; { Swap }


procedure Solve (var a, b, c : circle_array; var d : Integer);
{moving right: d = 1, moving left: d = 0}
var
	 ha, hb, hc	: Integer;
begin
	 ha := ArrayHeigth (a);
	 hb := ArrayHeigth (b);
	 hc := ArrayHeigth (c);
	 if (ha = 0) and (hb = 0) then
			Writeln ('Finished')
	 else
			if d = 1 then
			begin
				 c[hc + 1] := a[ha];
				 a[ha] := 0;
				 PrintArrays (a, b, c);

				 
				 b[hb + 1] := a[ha - 1];
				 a[ha - 1] := 0;
				 PrintArrays (a, b, c);

				 b[hb + 2] := c[hc + 1];
				 c[hc + 1] := 0;
				 PrintArrays (a, b, c);

				 c[hc + 1] := a[ha - 2];
				 a[ha - 2] := 0;
				 PrintArrays (a, b, c);

				 a[ha - 2] := b[hb + 2];
				 b[hb + 2] := 0;
				 PrintArrays (a, b, c);

				 c[hc + 2] := b[hb + 1];
				 b[hb + 1] := 0;
				 PrintArrays (a, b, c);

				 c[hc + 3] := a[ha - 2];
				 a[ha - 2] := 0;
				 PrintArrays (a, b, c);

				 Swap (a, b);
				 d := 0;
				 PrintArrays (a, b, c);

				 Solve (a, b, c, d);
			end
			else
			begin
				 a[ha + 1] := c[hc];
				 c[hc] := 0;
				 PrintArrays (a, b, c);

				 b[hb + 1] := c[hc - 1];
				 c[hc - 1] := 0;
				 PrintArrays (a, b, c);

				 b[hb + 2] := a[ha + 1];
				 a[ha + 1] := 0;
				 PrintArrays (a, b, c);

				 a[ha + 1] := c[hc - 2];
				 c[hc - 2] := 0;
				 PrintArrays (a, b, c);

				 c[hc - 2] := b[hb + 2];
				 b[hb + 2] := 0;
				 PrintArrays (a, b, c);

				 a[ha + 2] := b[hb + 1];
				 b[hb + 1] := 0;
				 PrintArrays (a, b, c);

				 a[ha + 3] := c[hc - 2];
				 c[hc - 2] := 0;
				 PrintArrays (a, b, c);

				 Swap (b, c);
				 d := 1;
				 PrintArrays (a, b, c);
				 
				 Solve (a, b, c, d);
			end;
end; { Solve }


var
	 a, b, c			: circle_array;
	 i, direction	: Integer;
	 
begin
	 Writeln ('Number of circles: ', N);
	 
	 for i := 1 to N do
	 begin
			a[i] := N - i + 1;
			b[i] := 0;
			c[i] := 0;
	 end;
	 direction := 1;
	 PrintArrays (a, b, c);
	 Solve (a, b, c, direction);

end.