program Hanoy;
uses Crt,Graph;
type ArrType =array [1..1] of byte;
var Col,
    Beg,End_ :byte;
    Arr      :^ArrType;
    i,j      :integer;

    CountMoves: longint;

procedure GraphInit;
 var GrDr,GrMode:integer;
 begin
   GrDr:=Detect;
   GrMode:=0;
   InitGraph(GrDr,GrMode,'');
 end;
procedure DrawRings;
 var a,b,c:byte;
 begin
   ClearDevice;
   SetColor(White);
   Line(100,200,100,400);
   Line(300,200,300,400);
   Line(500,200,500,400);
   Line(50,400,550,400);
   SetFillStyle(SolidFill, Red);
   SetColor(Yellow);
   j:=0;a:=0;b:=0;c:=0;
   for i:=1 to Col do
     case Arr^[i] of
       0:Inc(a);
       1:Inc(b);
       2:Inc(c);
     end;
   for i:=1 to Col do
     begin
       case Arr^[i] of
         0:begin
             Bar(100+Arr^[i]*200-i*5,400-a*5,100+Arr^[i]*200+i*5,400-a*5-5);
             Rectangle(100+Arr^[i]*200-i*5,400-a*5,100+Arr^[i]*200+i*5,400-a*5-5);
             Dec(a);
           end;
         1:begin
             Bar(100+Arr^[i]*200-i*5,400-b*5,100+Arr^[i]*200+i*5,400-b*5-5);
             Rectangle(100+Arr^[i]*200-i*5,400-b*5,100+Arr^[i]*200+i*5,400-b*5-5);
             Dec(b);
           end;
         2:begin
             Bar(100+Arr^[i]*200-i*5,400-c*5,100+Arr^[i]*200+i*5,400-c*5-5);
             Rectangle(100+Arr^[i]*200-i*5,400-c*5,100+Arr^[i]*200+i*5,400-c*5-5);
             Dec(c);
           end;
       end;
     end;
   if ReadKey=#27 then begin
      CloseGraph;
      halt(1);
   end;
   while KeyPressed do Readkey;
 end;
procedure PrintQuant(c,b,e:byte);
 begin
   Arr^[c]:=e;
   DrawRings;
   Inc(CountMoves);
 end;
procedure Move(c,b,e:byte);
 begin
   if c=1 then PrintQuant(c,b,e)
   else
     begin
       Move(c-1,b,3-b-e);
       PrintQuant(c,b,e);
       Move(c-1,3-b-e,e);
     end;
 end;
begin
  CountMoves := 0;

  GraphInit;
  Beg:=0;
  End_:=2;
  Col:=4;
  GetMem(Arr,Col);
  for i:=1 to Col do
    Arr^[i]:=Beg;
  DrawRings;
  Move(Col,Beg,End_);
  Freemem(Arr,Col);
  CloseGraph;

  writeln('Count = ', CountMoves);
  ReadLn;
end.