汉诺塔(梵塔)游戏

var Y: byte;
begin
fillchar(Situation, sizeof(Situation), 0);
for Y := 1 to N do
Situation[Y, 1] := Y;
end;
procedure OutPut;
var d
rule;
if loadRecord then writeln('继续上次游戏');
repeat
K := 0;
MinStep(N);
writeln('第 ', N, ' 层至少需要走 ', k, ' 步');
end;
procedure MinStep(N: word);
begin
if N = 0 then exit;
MinStep(N - 1);
inc(K);
MinStep(N - 1);
end;
begin
if not LoadRecord then
begin
for I := 1 to 3 do
begin
T := 1;
while (Situation[T, I ] = 0) and (T <> N) do inc(T);
A[I] := Situation[T, I];
end;
fillchar(CanMove, sizeof(CanMove), 0); X := 0;
writeln('恭喜,你已经通过第 ',N,' 层');
inc(N);
if N <> 10 then
begin
MakeUp;
Step := 0;
RecordFire;
end;
until N = 10;
for T := 1 to 3 do
for I := 1 to 3 do
if A[T] <> 0 then
if (A[T] < A[I]) or(A[I] = 0) then
begin
inc(X);
CanMove[X] := 10 * T + I;
repeat
OutPut;
Tip;
ReadGo;
Move(M); writeln('已走 ', Step, '步');
RecordFire;
until (Situation[N, 1] = 0) and (Situation[N, 2] = 0);
read(F1, Situation[N, X]);
inc(N);
end;
dec(N);
close(F1);
end
else LoadRecord := false;
end;
procedure MakeUp;
end;
write('你可以输入:');
for X := 1 to 6 do
if CanMove[X] <> 0 then write(CanMove[X]:6);
write(' 这些数字中的一个后按回车键: ');
end;
procedure ReadGo;
N, K , M, Step: word;
F1: file of word;
Yes: boolean;
procedure Rule;
begin
writeln('规则: 塔片只能从上到下从小到大叠放');
writeln;
writeln(' 将所有的塔片移到 3 的位置则过关');
{ Made by Benjaminzhou 游戏下载链接/share/link?shareid=7621&uk=2988004704 }
uses Sysutils;
var Piece: array[0..9] of shortstring
=(' ',
write(F1, Situation[Y, X]);
close(F1);
end;
function LoadRecord: boolean;
var X: byte;
begin
if fileExists('RecordFire') then
begin
LoadRecord := true;
begin
for f := 1 to 20 - N do writeln;
for f := 1 to N do
begin
for d := 1 to 3 do
write(Piece[Situation[f, d]]);
writeln;
' ★ ',
' ◢▇◣ ',
' ◢▇▇◣ ',
' ◢▇▇▇◣ ',
' ◢▇▇▇▇◣ ',
' ◢▇▇▇▇▇◣ ',
writeln;
writeln(' 按照提示输入一个两位数字XY, X是十位, Y是个位');
writeln;
writeln(' 输入后按回车表示将 X 位置塔片移到 Y 位置');
writeln;
writeln('请输入回车键开始');
readln;
N := 9;
OutPut;
writeln('恭喜你已经完全通关');
fillchar(Situation, sizeof(Situation), 0);
N := 2;
MakeUp;
RecordFire;
readln;
end.
end;
writeln(' 1 2 3');
end;
procedure Tip;
var A: array[1..3] of byte;
T, I, X: byte;
begin
until (M <> 0) and Yes;
end;
procedure Move(M: word);
var X, Y, T, I: byte;
begin
X := M div 10;
Y := M mod 10;
T := 1; I := N;
while Situation[T, X] = 0 do inc(T);
end;
Procedure RecordFire;
var X, Y: byte;
begin
assign(F1, 'RecordFire');
rewrite(F1);
write(F1, Step);
for Y := 1 to N do
for X := 1 to 3 do
var T: byte;
begin
repeat
readln(M);
Yes := false;
for T := 1 to 6 do
if CanMove[T] = M then Yes := true;
if not Yes then write('请重新输入以上提示数字中的一个后按回车键: ');
' ◢▇▇▇▇▇▇◣ ',
' ◢▇▇▇▇▇▇▇◣ ',
' ◢▇▇▇▇▇▇▇▇◣ ');
Situation: array[1..9, 1..3] of word;
CanMove: array[1..6] of word;
while Situation[I, Y] <> 0 do dec(I);
Situation[I, Y] := Situation[T, X];
Situation[T, X] := 0;
inc(Step);
writeln('已将 ', X, ' 位置塔片移到 ', Y, ' 位置');
assign(F1, 'RecordFire');
reset(F1);
read(F1, Step);
N := 1;
while not eof(F1) do
begin
for X := 1 to 3 do