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 *)