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 [50] = ('Not bad.', 'Good !',
                                             'Very well !!',
                                             'Do not stop !',
                                             'Patience!',
                                             'Terrific! One more game !!!',
                                             'THAT IS IT !!!');

Label BEGINNING_OF_MAIN_BLOC;
Procedure Cancel;
Begin
  flag := 11;
End;

Procedure Title;
Begin
  While KeyPressed Do ReadKey;
  n := 3;
  flag := 29;
  clrscr;
  Window(1,1,40,25);
  GotoXY(1,2);
  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('Author: I. Pashev, 11g');
  GotoXY(15,18);
  Write('Severoonezhsk');
  window (12,8,30,14);
  clrscr;
  TextColor(Magenta);
  Window(11,7,29,13);
  ClrScr;
  GotoXY(6,2);
  Write('H A N O I');
  GotoXY(6,6);
  Write('T O W E R');
  window(1,1,40,25);
  GotoXY(2,25);
  Write('       - Dec 1997 - Jan 2023 -         ');
  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;
End;

Procedure Prepare;
Procedure maxq;
Begin
  mq := 1;
  For z:=1 To n Do
    mq := mq*2;
  mq := mq-1;
End;
Begin
  ClrScr;
  Window(1,1,80,25);
  k := FALSE;
  flag := 29;
  hp[1] := n;
  hp[2] := 0;
  hp[3] := 0;
  h := 1;
  allrings := FALSE;
  MAXQ;
  q := 0;
  TextColor(Yellow);
  WriteLN('Max moves: ',mq);
  Write('Moves done: ');
  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] + 'O';
      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 spaces}
Procedure LevelComplete;
Begin
  GotoXY(1,4);
  Write(m[n]);
  allrings := TRUE;
  GotoXY(1,5);
  Write('P R E S S "Space"');
  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
      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;
  k := FALSE;
  If h2<>h Then Dec(hp[h]);
  If Not (allrings) And (h2<>h) Then
    Begin
      Inc(q);
      GotoXY(13,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
  GotoXY(30,20);
  Write(' L O S E R! ');
  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;
    Playing;
  Until flag<>0;
  If flag=2 Then BadLuck;
  GOTO BEGINNING_OF_MAIN_BLOC;
End.