home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / bonus / tpwform / hanoi.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-11  |  3KB  |  140 lines
  1. {
  2. I saw a postihg yesterday requesting source code for the Tower of Hanoi
  3. problem. This proplem is an old chestnut which we drag out to demonstrate
  4. recursion after we realize that factorial is really iteration.
  5.  
  6. Here is source code done in TPW1.5.
  7. }
  8.  
  9. program TowersofHanoi;
  10.  
  11. uses
  12.   CRT; { Not needed unless using Windows version }
  13.        { copyright 1993 E. Kurt TeKolste }
  14.        { no rights reserved }
  15.  
  16. const
  17.   Max = 20;  { Use all of this at your peril }
  18.   A   = 'A';  { Names of the three towers }
  19.   B   = 'B';
  20.   C   = 'C';
  21.  
  22. type
  23.   Stack = 1..Max;
  24.   Disk  = 0..Max;
  25.  
  26.   Tower = object
  27.     Depth : integer;  { the current number of disks on the tower }
  28.     V : array[Stack] of Disk; { the sizes of the disks on the tower }
  29.  
  30.     constructor Init(N : integer); {creates a tower with disks 1..N }
  31.     procedure Add(D : Disk);     { Adds a disk of size D on top }
  32.     function  Remove : Disk;     { Removes the top disk and returns its size }
  33.     procedure Print;   { Prints a tower }
  34.   end;
  35.  
  36. constructor Tower.Init(N : integer);
  37. var
  38.   I : Disk;
  39. begin
  40.   Depth := N;
  41.   for I := 1 to N  do V[I] := I;
  42.   for I := succ(N) to Max do V[I] := 0;
  43. end;
  44.  
  45. procedure Tower.Add(D : Disk);
  46. begin
  47.   Depth    := succ(Depth);
  48.   V[Depth] := D;
  49. end;
  50.  
  51. function Tower.Remove : Disk;
  52. begin
  53.   Remove := V[Depth];
  54.   Depth  := pred(Depth);
  55. end;
  56.  
  57. procedure Tower.Print;
  58. var
  59.   I : Stack;
  60. begin
  61.   clreol;
  62.   for I := 1 to Depth do write(V[I]:3);
  63. end;
  64.  
  65. type
  66.   Hanoi = object
  67.     Display : boolean;  { If true, each move is displayed. }
  68.     Pause   : boolean;  { If true, waits for keypress to continue after
  69.                           each move. }
  70.     S       : Stack;    { The number of disks on the towers.}
  71.     H       : array[A..C] of Tower;
  72.  
  73.     constructor Init(I : Stack; On : boolean; Wait : boolean);
  74.                 { Creates a tower of Hanoi with I disks, the display
  75.                   determined by On and the pause determined by Wait. }
  76.     procedure Move( N : integer; var Source, Sink, Using : Tower);
  77.                     { Moves the top N disks from Source to Sink using Using. }
  78.     procedure Transfer;
  79.                        { Moves all of the disks from A to C. }
  80.     procedure Print;
  81.                         { Prints the Towers of Hanoi }
  82.   end;
  83.  
  84. constructor Hanoi.Init(I : Stack; On : boolean; Wait : boolean);
  85. begin
  86.   if I < Max then S := I else S := Max;
  87.   Display := On;
  88.   Pause   := Wait;
  89.   H[A].Init(S);
  90.   H[B].Init(0);
  91.   H[C].Init(0);
  92. end;
  93.  
  94. procedure Hanoi.Move(N : integer; var Source, Sink, Using : Tower);
  95. var
  96.   F : char;
  97. begin
  98.   if N > 0 then
  99.   begin
  100.     Move(N-1, Source, Using, Sink);
  101.     Sink.Add(Source.Remove);
  102.     if Display then
  103.     begin
  104.       Print;
  105.       if Pause   then
  106.       begin
  107.         repeat until keypressed;
  108.         F := readkey;
  109.       end;
  110.     end;
  111.     Move(N-1, Using, Sink, Source);
  112.   end;
  113. end;
  114.  
  115. procedure Hanoi.Print;
  116. var
  117.   X : A..C;
  118. begin
  119.   for X := A to C do
  120.   begin
  121.     gotoxy(1,ord(X) - Ord(A) + 1);
  122.     H[X].Print;
  123.   end;
  124. end;
  125.  
  126. procedure Hanoi.Transfer;
  127. begin
  128.   Move(S, H[A], H[B], H[C]);
  129. end;
  130.  
  131. var
  132.   T : Hanoi;
  133. begin
  134.   with T do
  135.   begin
  136.     Init(6,true,true);
  137.     Transfer;
  138.   end;
  139. end.
  140.