SOURCE FILE: hanoi.pas

Program TowersOfHanoi (input, output) ;

(***************************************************************)
(*                        STACK ADT                            *)
(*                (Array-based Implementation)                 *)
(***************************************************************)
CONST  MaxStack = 26;
       tenBlanks = '          ' ;
TYPE  StackElementType = integer ;
      StackType  = RECORD
        Elements : ARRAY [1 .. MaxStack] OF StackElementType;
        Top      : 0 .. MaxStack
      END; (* StackType *)

      stackTriple =  array [1..3] of stackType ;

var numRings, i  : integer ;
    stacks : stackTriple ;
(***************************************************************)
PROCEDURE CreateStack
  (VAR Stack : StackType);
  (* Initializes Stack to empty state. *)
BEGIN (* CreateStack *)
  Stack.Top := 0
END;  (* CreateStack *)
(****************************************************************)
PROCEDURE DestroyStack
  (VAR Stack : StackType);
  (* Destroys all elements in stack, leaving Stack empty. *)
BEGIN (* DestroyStack *)
  Stack.Top := 0
END;  (* DestroyStack *)
(****************************************************************)
FUNCTION EmptyStack
  (Stack : StackType) : Boolean;
  (* Returns True if Stack is empty; returns False otherwise. *)
BEGIN (* EmptyStack. *)
  EmptyStack := Stack.Top = 0
END; (* EmptyStack *)
(****************************************************************)
FUNCTION FullStack
  (Stack : StackType) : Boolean;
  (* Returns True if Stack is full; returns False otherwise. *)
BEGIN (* FullStack *)
  FullStack := Stack.Top = MaxStack
END; (* FullStack *)
(****************************************************************)
PROCEDURE Push
  (VAR Stack  : StackType;
   NewElement : StackElementType);
  (* Adds NewElement to the top of Stack. Assumes that the *)
  (* stack is not full.                                    *)
BEGIN (* Push *)
  Stack.Top := Stack.Top + 1;
  Stack.Elements[Stack.Top] := NewElement
END; (* Push *)
(****************************************************************)
PROCEDURE Pop
  (VAR Stack         : StackType;
   VAR PoppedElement : StackElementType);
  (* Removes the top element from Stack and returns its *)
  (* value in PoppedElement. Assumes that the stack is  *)
  (* not empty.                                         *)
BEGIN (* Pop *)
  PoppedElement := Stack.Elements[Stack.Top];
  Stack.Top := Stack.Top - 1
END; (* Pop *)
(****************************************************************)
procedure DrawThreeStacks (stacks : stackTriple );
var max, i, j : integer ;
begin  (* procedure DrawThreeStacks *)
    (* Find out the height of the highest stack *)
  max := stacks[1].top ;
  if stacks[2].top > max then max := stacks[2].top ;
  if stacks[3].top > max then max := stacks[3].top ;
  writeln; writeln;
    (*  Write the stack elements from the top down *)
  for i := max downto 1 do
  begin
       (*  write level i of all stacks, in order, going across *)
    for j := 1 to 3 do
    begin
         (*  If stack j contains an element at level i *)
      if stacks[j].top >= i
         (*  then write it now  *)
      then write (stacks[j].elements[i]:10)
         (*  otherwise leave the space blank. *)
      else write (tenBlanks);
         (*  Make some extra space between stacks. *)
      if j < 3 then write (tenBlanks);
    end ;
      (* Move down to the next line, to get ready to print the
         next level of the drawing *)
    writeln ;
  end ;
    (*  Put a little base on the drawing, and mark the locations
        of the "pegs". *)
  writeln('     ------------------------------------------------');
  writeln('         ^                   ^                   ^');
end ;  (* procedure DrawThreeStacks *)
(****************************************************************)
procedure Hanoi (number : integer ;
                 var sourceStack, targetStack, spareStack : stackType ) ;
var tempElt : stackElementType ;		 
begin (* procedure Hanoi *)
     (* If there is more than one ring on the puzzle *)
  if    number > 1
     (* then recursively move all rings except the bottom ring
	off the sourceStack and onto the spareStack *)
  then  Hanoi (number-1, sourceStack, spareStack, targetStack);
     (* Now move the bottom ring off the sourceStack and onto
        the targetStack *)
  Pop (sourceStack, tempElt);
  Push (targetStack, tempElt) ;
    (* Since the puzzle has changed state, show how it looks now *)
  DrawThreeStacks (stacks) ;
    (*  If there is more than one ring on the puzzle *)
  if    number > 1 
    (* then recursively move all the rings on the spareStack
       onto the targetStack (now that the bottom ring has been
       moved to the targetStack) . *)
  then  Hanoi (number-1, spareStack, targetStack, sourceStack);
end ; (* procedure Hanoi *)		 
(****************************************************************)
begin  (* Program TowersOfHanoi *)
  writeln ('How many rings on the puzzle?');
  writeln ('Enter a number between 1 and ', maxstack:1,'.');
  writeln ('Hint: Start with a SMALL number!') ;
  readln(numRings);
  if (numRings > 0) and (numRings <= maxstack)
  then
  begin
       (* initialize the puzzle, and draw it *)
    for i := 1 to 3 do CreateStack(stacks[i]);
    for i := numRings downto 1 do Push(stacks[1], i) ;
    DrawThreeStacks (stacks) ;
      (* Now solve it. *)
    Hanoi (numRings, stacks[1], stacks[3], stacks[2]);
  end ;
end.   (* Program TowersOfHanoi *)