home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / HANOI.ZIP / HANOI.PAS
Encoding:
Pascal/Delphi Source File  |  1985-12-28  |  1.8 KB  |  68 lines
  1. program hanoi;
  2.  
  3. var
  4.   n, a, b, c, ah, bh, ch, x, timer: integer;
  5.   response: char;
  6.   manual: boolean;
  7.   xtimer: real;
  8.  
  9. procedure erase(i,x:integer; var xh:integer);
  10.   var j,k,l: integer;
  11.     begin
  12.     l := 170-5*xh;
  13.     k := 100*x-40;
  14.     for j := l to l+3 do begin
  15.     Draw(k-2*i-2,j,k+2*i+3,j,0);
  16.     Plot(k,j,1);
  17.     end;
  18.     xh := xh - 1;
  19.     end;
  20.  
  21. procedure create(i,x:integer; var xh:integer; manual:boolean; timer:integer);
  22.   var j,k,l: integer;
  23.     begin
  24.     xh := xh + 1;
  25.     l := 170-5*xh;
  26.     k := 100*x-40;
  27.     for j := l to l+3 do Draw(k-2*i-2,j,k+2*i+3,j,2);
  28.     if manual then read(response) else Delay(timer);
  29.     if KeyPressed then read(response);
  30.     end;
  31.  
  32. procedure han(n,a,b,c:integer;var ah,bh,ch:integer; manual:boolean; timer:integer);
  33.   begin
  34.     if n>1 then han(n-1,a,c,b,ah,ch,bh,manual,timer);
  35.     erase(n,a,ah); create(n,b,bh,manual,timer);
  36.     if n>1 then han(n-1,c,b,a,ch,bh,ah,manual,timer);
  37.   end;
  38.  
  39. begin
  40.   write('This program requires color adapter.  Do you have one? ');
  41.   readln(response); if (response='n') or (response='N') then Halt;
  42.   repeat
  43.     write ('Number of disks (1-20): ');
  44.     readln (n);
  45.   until (n>0) and (n<21);
  46.   repeat
  47.     write ('Delay time in seconds (0-10 or -1 for manual) ');
  48.     readln (xtimer);
  49.     if xtimer<0 then begin
  50.       xtimer := 0;
  51.       manual := true;
  52.       end else manual := false;
  53.   until (xtimer>=0) and (xtimer<=10);
  54.   timer := trunc(xtimer * 1000);
  55.   GraphColorMode;
  56.   Palette(0);
  57.   GraphBackground(9);
  58.   for x := 170 to 180 do Draw(14,x,306,x,3);
  59.   Draw(60,65,60,170,1);
  60.   Draw(160,65,160,170,1);
  61.   Draw(260,65,260,170,1);
  62.   ah := 0; bh := 0; ch := 0;
  63.   for x := n downto 1 do create(x,1,ah,false,0);
  64.   han(n,1,3,2,ah,ch,bh,manual,timer);
  65.   if not manual then readln(response);
  66.   TextMode;
  67. end.
  68.