1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224

{ Author: Fl vio Augusto de Freitas, Brazilian
  Date: September 15, 2000
 
  Goal: This simple program shows a use of the recursive program to solve
         a problem. In this case, THE TOWER OF HANOI. Unfortunately, the            width of the screen (80 columns) hold the graphic animation to
            a high 13 wheels on a peg. Well, I think this is better than the
            numeric solution I've saw on the Internet because a image is better
            than thousands of words.
   Table of Movements: The number of movements can be calculated by the
        formula:
 
            W
           2  - 1, where W is the Number of Wheels to move. 
        Number of Wheels     Minimum of Movements
        ----------------     --------------------
                1                       1
                2                       3                3                       7
                4                      15
                5                      31
                6                      63
                7                     127                8                     255
                9                     511
               10                    1023
               11                    2047
               12                    4095               13                    8191
 
  The TOWER OF HANOI Problem: To solve this simple problem, think you have
         three pegs on a surface numbered 1, 2, 3, left to right. On the peg
            1 you put 3 of more wheels of different sizes, the largest under            minor.
            You must change the wheels of peg 1 to the peg 3, but you must move
            only a one wheel a time and a large wheel never can stay over a minor.
        The problem get harder when you increase the number of wheels. In
        effect with 13 wheels you have to do a minimum of 8191 movements.        (See table above).
 
  History of TOWER OF HANOI: The legendaries Towers of Hanoi keep on a temple
        in the middle of forest. (What forest? No matter!) There are 64
        wheels of polish bronze, and groups of monks dressed of black        continuously moves one wheel a time from a peg to another. When
        they terminate, will be the final of the universe. Well, that's the
        history say! If they stir one wheel by second, they will take
            half trillion of years; therefore, you cann't change your plans for
        the weekend!        Using the formula below, you can calculate the amount of movements
        necessary to make this hard job!
}
program TowersOfHanoi;
 uses Crt;
 
const
  Time = 5000;    { The delay time in miliseconds before execute a movement }
  MaxDisks = 13; { The amount of disks on a particular peg }  Wheels: array[0..MaxDisks] of String[25] = (
     '            Ãƒâ€šÃ‚º            ',  {  0 }
     '            ÃƒÆ’Å“            ',  {  1 }
     '           ÜÜÜ           ',  {  2 }
     '          ÃƒÆ’œÃœÃœÃœÃœ          ',  {  3 }     '         ÜÜÜÜÜÜÜ         ',  {  4 }
     '        ÃƒÆ’œÃœÃœÃœÃœÃœÃœÃœÃœ        ',  {  5 }
     '       ÜÜÜÜÜÜÜÜÜÜÜ       ',  {  6 }
     '      ÃƒÆ’œÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœ      ',  {  7 }
     '     ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ     ',  {  8 }     '    ÃƒÆ’œÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœ    ',  {  9 }
     '   ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ   ',  { 10 }
     '  ÃƒÆ’œÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœÃœ  ',  { 11 }
     ' ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ ',  { 12 }
     'ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ'); { 13 }  Base = 'ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÅÂ� ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÅÂ� ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÅÂ� ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?ÃÂ?';
 
var
  NumDisks: Integer;  { Amount of wheels to move }
  Movements: Integer; { Present move }  Pegs: array[1..MaxDisks, 1..3] of Byte; { The pegs Lines by Columns }
  OldWhereX, OldWhereY: Integer;
 
procedure ShowTowers;
var  C: Integer;
begin
  TextColor(BROWN);
  for C := 1 to MaxDisks do
  begin    GotoXY(1, C);
      Write(Wheels[Pegs[C, 1]] + Wheels[Pegs[C, 2]] + Wheels[Pegs[C, 3]]);
  end;
  GotoXY(1, MaxDisks + 1);
  Write(Base);  TextColor(WHITE);
  GotoXY(55, MaxDisks + 2);
  Write('Move #: ', Movements);
  GotoXY(1, MaxDisks + 3);
  TextColor(YELLOW + BLINK);  Writeln('Press any key to exit . . .');
  TextColor(WHITE);
end;
 
procedure InitPegs;var
  C, TotDisks: Integer;
begin
  Movements := 0;
  TotDisks := NumDisks;  for C := MaxDisks downto 1 do
  begin
    if TotDisks > 0 then
    begin
        Pegs[C, 1] := TotDisks;         TotDisks := TotDisks - 1;
    end;
    Pegs[C, 2] := 0;
    Pegs[C, 3] := 0;
  end;  OldWhereX := 1;
  OldWhereY := 1;
end;
 
function LittleButZero(Peg: Integer): Integer;var
  C, Index, Little: Integer;
begin
  Little := NumDisks + 1;
  Index := MaxDisks;  for C := MaxDisks downto 1 do
    if (Pegs[C, Peg] < Little) and (Pegs[C, Peg] <> 0) then
    begin
      Little := Pegs[C, Peg];
      Index := C;    end;
  LittleButZero := Index;
end;
 
procedure ShowMoves(From, Target: Integer);var
  C: Integer;
begin
  GotoXY(2, 17); Write(#201);   { É }
  GotoXY(79, 17); Write(#187);  { » }  for C := 3 to 78 do
   begin
    GotoXY(C, 17); Write(#205); { ÃÂ? }
    GotoXY(C, 25); Write(#205); { ÃÂ? }
   end;  GotoXY(2, 25); Write(#200);  { ÃËâ€�  }
  GotoXY(79, 25); Write(#188);  { ¼ }
 
  GotoXY(2, 18); Write(#186);   { º }
  GotoXY(2, 19); Write(#186);   { º }  GotoXY(2, 20); Write(#186);   { º }
  GotoXY(2, 21); Write(#186);   { º }
  GotoXY(2, 22); Write(#186);   { º }
  GotoXY(2, 23); Write(#186);   { º }
  GotoXY(2, 24); Write(#186);   { º }  GotoXY(79, 18); Write(#186);  { º }
  GotoXY(79, 19); Write(#186);  { º }
  GotoXY(79, 20); Write(#186);  { º }
  GotoXY(79, 21); Write(#186);  { º }
  GotoXY(79, 22); Write(#186);  { º }  GotoXY(79, 23); Write(#186);  { º }
  GotoXY(79, 24); Write(#186);  { º }
 
  Window(3, 18, 78, 24);
  GotoXY(OldWhereX, OldWhereY);  Write(From, ' --> ', Target, '; ');
  OldWhereX := WhereX; OldWhereY := WhereY;
  Window(1, 1, 80, 25);
end;
 procedure MoveLittle(From, Target: Integer);
var
  LittleFrom, LittleTarget: Integer;
begin
  LittleFrom := LittleButZero(From);  LittleTarget := LittleButZero(Target);
 
  while Pegs[LittleTarget, Target] <> 0 do LittleTarget := LittleTarget - 1;
  Pegs[LittleTarget, Target] := Pegs[LittleFrom, From];
  Pegs[LittleFrom, From] := 0; 
  if KeyPressed then
  begin
    GotoXY(1, MaxDisks + 3);
    TextColor(RED);    Write(#7#7'Stopped by user . . .        ');
    Halt(1);
  end;
  Movements := Movements + 1;
  ShowMoves(From, Target);  ShowTowers;
  Delay(Time);
end;
 
procedure DoTowers(NumDisks, OrigPeg, NewPeg, TempPeg: Integer);begin
  if NumDisks = 1 then
    MoveLittle(OrigPeg, NewPeg)
  else
  begin    DoTowers(NumDisks - 1, OrigPeg, TempPeg, NewPeg);
      MoveLittle(OrigPeg, NewPeg);
    DoTowers(NumDisks - 1, TempPeg, NewPeg, OrigPeg);
  end;
end; 
begin
  repeat
   ClrScr;
   Write('Disks (up to 13): '); Readln(NumDisks);  until (NumDisks <= MaxDisks) and (NumDisks >= 0);
  if NumDisks = 0 then Halt(0);
  ClrScr;
  InitPegs;
  ShowTowers;  DoTowers(NumDisks, 1, 3, 2);
  Writeln; Writeln;
  repeat until KeyPressed;
end.