Калейдоскоп из комбинаторных алгоритмов

{Программа реализована с помощью абстрактного типа данных –
стек для произвольного числа дисков. Число колец задается
константой maxc. Программа написана на языке
программирования Turbo-Pascal}

program Tower;
uses Crt, Graph;

const maxc = 4;{Максимальное число колец на одной башне}

type TTower = record
  num: byte;
  sizes: array[1..maxc] of byte;
  up: byte;
end;

var Towers: array[1..3] of TTower;
    VisVP, ActVP: byte; {видимая и активная видеостраницы}
    ActTower: byte;
    Message: String;
    Win: boolean;
    font1: integer;

function CheckEnd: boolean;
var res: boolean;
    i: byte;
begin
  res:=False;
  if (Towers[2].num=maxc) or (Towers[3].num=maxc) then res:=true;
  CheckEnd:=res;
end;

procedure BeginDraw;
begin
  SetActivePage(ActVP);
end;

procedure EndDraw;
begin

VisVP:=ActVP;
  SetVisualPage(VisVP);
  if VisVP=1 then ActVP:=0 else ActVP:=1;
end;

procedure Init;
var grDr, grM: integer;

ErrCode: integer;
    i: integer;
begin
  grDr:=VGA;
  grM:=VGAMed;
  InitGraph(grDr, grM, 'c:\borland\tp\bgi');
  ErrCode:=GraphResult;
  if ErrCode <> grOk then
  begin
    Writeln('Graphics error:', GraphErrorMsg(ErrCode));
    Halt;
  end;

Towers[1].num:=maxc;
  Towers[1].up:=0;
  for i:=0 to maxc-1 do
    Towers[1].sizes[i+1]:=maxc-i;

Towers[2].num:=0;
  Towers[2].up:=0;
  for i:=0 to maxc-1 do
    Towers[2].sizes[i+1]:=0;

p>Towers[3].num:=0;
  Towers[3].up:=0;
  for i:=0 to maxc-1 do
    Towers[2].sizes[i+1]:=0;

ActTower:=1;
  VisVP:=0; ActVP:=1;
  SetVisualPage(VisVP);
  SetActivePage(ActVP);
  Message:='';
  Win:=False;
end;

procedure Close;
begin
  closegraph;
end;

procedure DrawTower(x, y: integer; n: integer);
var i: integer;
begin
  if n=ActTower then
    SetColor(yellow);
  Line(x, y, x, y+15+maxc*15);
  for i:=1 to Towers[n].num do
  begin
    Rectangle(x-10*Towers[n].sizes[i], y+15+15*(maxc-i+1),
x+10*Towers[n].sizes[i], y+15+15*(maxc-i))
  end;

if Towers[n].up<>0 then
  begin
    Rectangle(x-10*Towers[n].up, y-15, x+10*Towers[n].up, y-30);
  end;

SetColor(White);
end;

procedure DrawInfo;
begin
  OutTextXY(50, 20, 'Ханойская башня.);
  OutTextXY(80, 40, 'Работа с программой: стрелки влево-вправо - выбор
башни');
  OutTextXY(130, 60, 'текущая башня выделяется желтым цветом');
  OutTextXY(60, 80, 'стрелка вверх - поднять кольцо, стрелка вниз -
положить кольцо');
  OutTextXY(80, 100, '(две последние операции выполняются для активной
башни)');

end;

procedure Draw;
begin
  BeginDraw;
  ClearDevice;
  OutTextXY(180, 140, Message); Message:='';
  DrawTower(150, 200, 1);
  DrawTower(300, 200, 2);
  DrawTower(450, 200, 3);

if win then
  begin
    SetTextStyle(GothicFont, HorizDir, 8);
    SetColor(Red);
    Outtextxy(70, 0, 'Congratulations');
    Outtextxy(160, 70, 'You win');
    SetTextStyle(DefaultFont, HorizDir, 1);
    SetColor(White);
    OutTextXY(250, 330, 'Press any key');
  end
  else
    DrawInfo;
  EndDraw;
end;

procedure MainCycle;
var ch: char;
    ex: boolean;
    up: byte;
begin
  ex:=False;
  repeat
    if KeyPressed then
    begin
      ch:=ReadKey;
      case ch of
      #27: begin
             Ex:=True;
           end;
      #77: begin
             up:=Towers[ActTower].up;
             Towers[ActTower].up:=0;
             inc(ActTower);
             if ActTower>3 then ActTower:=1;
             Towers[ActTower].up:=up;
           end;
      #75: begin
             up:=Towers[ActTower].up;
             Towers[ActTower].up:=0;
             dec(ActTower);
             if ActTower<1 then ActTower:=3;
             Towers[ActTower].up:=up;
           end;
      #80: begin    {вниз}
             if Towers[ActTower].up<>0 then
             begin
               if Towers[ActTower].num=0 then
               begin
                 Towers[ActTower].num:=Towers[ActTower].num+1;

Towers[ActTower].sizes[Towers[ActTower].num]:=Towers[ActTower].up;
                 Towers[ActTower].up:=0;
               end
               else
               begin
                 if
Towers[ActTower].sizes[Towers[ActTower].num]>Towers[ActTower].up then
                 begin
                   Towers[ActTower].num:=Towers[ActTower].num+1;

Towers[ActTower].sizes[Towers[ActTower].num]:=Towers[ActTower].up;
                   Towers[ActTower].up:=0;
                 end
                 else
                   Message:='Это кольцо сюда опускать нельзя';
               end;
             end;
           end;
      #72: begin         {вверх}
             if Towers[ActTower].num<>0 then
             begin
               Towers[ActTower].num:=Towers[ActTower].num-1;

Towers[ActTower].up:=Towers[ActTower].sizes[Towers[ActTower].num+1];
               Towers[ActTower].sizes[Towers[ActTower].num+1]:=0;
             end;
           end;
      end;
      if CheckEnd then
      begin
        Win:=True;
        ex:=True;
      end;
      Draw;
    end;
  until ex;
end;

begin
  Init;
  Draw;
  MainCycle;
  if win then repeat until keypressed;
  Close;
end.