PROGRAM Hanoi_Tower;    {$B-}
USES    Crt;
VAR     n,h,flag:BYTE;

        q,mq,z,r,t:INTEGER;
        allrings,k:BOOLEAN;
        hp:   ARRAY [1..3] OF BYTE;
        rings:ARRAY [1..9] OF STRING [20];
        heaps:ARRAY [1..3,0..9] OF BYTE;
CONST   m:    ARRAY [3..9] OF STRING [46] =
        ('…‹Ž•Ž.', 'Ž—…œ •ŽŽ˜Ž !', 'Ž’‹ˆ—Ž !!',
         'ƒ‹€‚Ž… - … Ž‘’€€‚‹ˆ‚€’œ‘Ÿ € „Ž‘’ˆƒ“’ŽŒ !',
         'ˆƒ€ “—ˆ’ ’……ˆž, … ’€Š ‹ˆ ?',
         'Ž’Ÿ‘€ž™… !! …™đ Ž„ˆ “Ž‚…œ !!!',
         '“ ‚Ž’ ˆ ‚‘đ !!!');
LABEL BEGINNING_OF_MAIN_BLOC;
Procedure cancel;
 begin
  flag:=11;
 end;
PROCEDURE Title;
BEGIN
  WHILE KeyPressed DO ReadKey;
  n:=3;flag:=29;
  TextMode(C40);
  TextBackground(lightgray);clrscr;
  Window(1,1,40,25);
  TextColor(lightgreen);
               Write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍģ');
  GotoXY(1,24);Write('ĐÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĐ');
  FOR  z:=2 TO 23 DO
 BEGIN
   GotoXY(1,z);Write('ē');
   GotoXY(40,z);Write('ē');
 END;
  textcolor(white);
  GotoXY(12,17);Write('€ĸâŽā:ˆ. čĨĸ,11Ŗ');
  GotoXY(15,18);Write('‘ĨĸĨāŽŽ­ĨĻáĒ');
  TextBackground(black);
  window (12,8,30,14);clrscr;
  TextBackground(lightgray);TextColor(Magenta);
  Window(11,7,29,13);ClrScr;
  GotoXY(2,2);Write('• €  Ž ‰ ‘ Š € Ÿ');
  GotoXY(6,6);Write    (' € ˜  Ÿ');
  window(1,1,40,25);
  TextBackground(green);
  GotoXY(2,25);
  Write('            -„…Š€œ 1997-            ');
  REPEAT
   z:=Ord(ReadKey);
  CASE z OF

  120:IF n>3 THEN Dec(n);
  105:IF n<8 THEN Inc(n);
  27: halt;
  END;
  UNTIL z=13;
  TextMode(C80);
END;
PROCEDURE Prepare;
Procedure maxq;
 begin
  mq:=1;
  for z:=1 to n do
  mq:=mq*2;
  mq:=mq-1;
 end;
BEGIN
 ClrScr; k:=FALSE;flag:=29;
 hp[1]:=n;  hp[2]:=0;  hp[3]:=0;  h:=1;
 allrings:=FALSE; MAXQ; q:=0;
 TextColor(Yellow);
 WriteLN('Œ Ēá¨Ŧ Ģė­ŽĨ į¨áĢŽ ¯ĨāĨĒĢ ¤ëĸ ­¨Š: ',mq);
 Write('‘¤ĨĢ ­Ž ¯ĨāĨĒĢ ¤ëĸ ­¨Š: ');
 TextColor(White);Write(q);
 TextColor(LightCyan);
 GotoXY(1,20);
  Write('
























',
        '
























',
        '





























');
 t:=17-n;
 FOR z:=n DOWNTO 1 DO
 BEGIN
  rings[n-z+1]:='';
  FOR r:=1 TO 10-z DO
  rings[n-z+1] := rings[n-z+1] + #32;
  FOR r := 1  TO  2 * z  DO
  rings[n-z+1] := rings[n-z+1] + 'Û';
  FOR r:=1 TO 10-z DO
  rings[n-z+1] := rings[n-z+1] + #32;
 END;
 TextColor(White);
 GotoXY(16,21);Write('');
 FOR z:=1 TO n DO
 BEGIN
  GotoXY(7,20-z);
  Write(rings[z]);
  heaps[1,z]:=z;
 END;
END;
PROCEDURE Playing;
 VAR    h2:BYTE;
 CONST spc='                   ';{ 19 ¯āŽĄĨĢŽĸ}
Procedure LevelComplete;
 begin
  FOR z:=0 TO 31 DO
   BEGIN
   Sound(100+z*28);Delay(20);NoSound;Delay(40-z);
   END;
  GotoXY(1,4);Write(m[n]);
  allrings:=TRUE;
  GotoXY(1,5);Write(' € † Œ ˆ ’ …  "Ž…‹"');
  IF n=9 THEN flag:=1
         ELSE Inc(n);
  Delay(500);
 end;
PROCEDURE Go_to_heap (x:SHORTINT);
BEGIN
 IF (x < 1) OR (x > 3) THEN EXIT;
 GotoXY((h-1)*24+16,21);Write(#32);
 h:=x;
 GotoXY((h-1)*24+16,21);Write('');
END;
PROCEDURE up;
BEGIN
 IF hp[h]=0 THEN BEGIN
                 Write(#7);
                 Exit;
                 END;
 k:=TRUE;
 FOR z:=19-hp[h] DOWNTO t DO
  BEGIN
   GotoXY((h-1) * 24 + 7, z + 1); Write(spc);
   GotoXY((h-1) * 24 + 7, z);Write(rings [heaps [h,hp [h]]]);
   Delay(40);
  END;
  h2:=h;
END;
PROCEDURE down;
BEGIN
 IF heaps[h2,hp[h2]]>heaps[h,hp[h]] THEN BEGIN
                                    Write(#7);
                                    Exit;
                                    END;
 IF h2<>h THEN BEGIN
               Inc(hp[h2]);
               heaps[h2,hp[h2]]:=heaps[h,hp[h]];
               END;
 FOR z:=t TO 19-hp[h2] DO
  BEGIN
  GotoXY((h2-1)*24+7,z);Write(spc);
  GotoXY((h2-1)*24+7,z+1);Write(rings[heaps[h,hp[h]]]);
  Delay(40);
  END;
 Sound(100);Delay(200);NoSound;
 k:=FALSE;
 IF h2<>h THEN Dec(hp[h]);
 IF NOT (allrings) AND (h2<>h) THEN BEGIN
    Inc(q); GotoXY(25,2);  Write(q);
                                    END;
END;
PROCEDURE right;
BEGIN
 IF h2=3 THEN Exit;
 FOR z:=(h2-1)*24+8 TO 24*h2+7 DO
 BEGIN
  GotoXY(z,t);Write(rings[heaps[h,hp[h]]]);
  Delay(6);
 END;
 Inc(h2);
END;
PROCEDURE Left;
BEGIN
 IF h2=1 THEN Exit;
 FOR z:=(h2-1)*24+6 DOWNTO 24*(h2-2)+7 DO
  BEGIN
  GotoXY(z,t);
  Write(rings[heaps[h,hp[h]]]);
  Delay(6);
  END;
 Dec(h2);
END;
BEGIN
 REPEAT
 CASE ReadKey OF
  'H':IF NOT k THEN Up;
  'P':IF   k THEN Down;
  'M':IF k THEN Right
           ELSE Go_to_heap(h + 1);
  'K':IF k THEN Left
           ELSE Go_to_heap(h - 1);
  #27:Cancel;
  #32, #13:IF allrings THEN flag:=0;
  ELSE CONTINUE;
 END;
  IF q>mq THEN flag:=2 ELSE IF (hp[3]=n) AND NOT allrings THEN LevelComplete;
 UNTIL flag<>29;
END;
PROCEDURE BadLuck;
BEGIN
 FOR z:=31 DOWNTO 0 DO
  BEGIN
   Sound(100+z*28); Delay(50); NoSound; Delay(80-z*2);
  END;
 GotoXY(30,20);Write(' €„Ž ›‹Ž „“Œ€’œ! ');
 Delay(2500);
END;
  BEGIN          {Žá­Žĸ­ ī į áâė}

    CheckBreak:=FALSE;
    heaps[1,0]:=0; heaps[2,0]:=0; heaps[3,0]:=0;
BEGINNING_OF_MAIN_BLOC:
    Title;
    REPEAT
     Prepare;
    port[$3d4]:=10;
    port[$3d5]:=191;
    Playing;
    UNTIL flag<>0;
    if flag=2 then BadLuck;
GOTO BEGINNING_OF_MAIN_BLOC;
END.