Code found somewhere in the pubic domain. Now has printing of moves (Thanx nielsie95)
Changing a few variables in the code can and will make it crash, that's my idea. Break it, fix it, and repeat until it does what it is supposed to do or get tired of playing......lol
I know that Pascal is considered an older language and not very useful to some, but when I have gotten under the hood of other languages they seem to point back to this one, so here I am using Lazarus.
Tests run:
1. I used the number of disks 0 1 2 3 4 with 3 pegs to verify the code works. (mentally verify)
2. I pushed the upper limit to 32 (disks) and got "-1 moves"
3. I added another a 3rd Hanoi (lft, ctr, rgt, n - 1) and got a false answer
4. entered a text instead of number and got "error 106" (easy to fix)
what was verified:
1. code works
2. min disks is 0 max is 31
3. 32 bit machine
4. the code though recursive, stays with in the 3 peg limit
5. needs more work
I know it's not much, but it is fun.
Code:
program Pegtoy;
{$mode objfpc}{$H+}
uses
crt, sysutils,
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes
{ you can add units after this };
{$R *.res}
{Changelog}
{renamed to Pegtoy}
{hanoitowers4. printing was out of order}
{hanoitowers3. no printing}
{---------------------------------------------------}
{original code in public domain somewhere}
{further adapted from the link provived by nielsie95}
Var
disks: integer;
m: integer;
kb: boolean;
st: string;
Procedure Pegtoy(Lfm, Lto, Lus, n: integer);
begin
if n > 0 then
begin
Pegtoy(Lfm, Lus, Lto, n - 1);
m := m + 1;
writeln('move ', m:2,' ', Lfm:1, ' --> ', Lto:1);
Pegtoy(Lus, Lto, Lfm, n - 1);
end;
end;
procedure getdisks();
begin
writeln('working ...' );
Pegtoy(1, 3, 2,disks);
writeln('Solution takes: ', m:2 ,' moves.');
disks := 0;
m := 0;
writeln;
end;
begin //main
kb := true;
while (kb = true) do
begin
clrscr();
write('Enter the number of disks: ');
{$I-} // corrects runtime error 106
readln(disks);
{$I+}
begin
if (IOResult = 0) then
getdisks()
else
//-----//
writeln;
writeln;
write('Press <Enter> To Quit or <P> to Play Again ');
readln(st);
st := UpperCase(st);
begin
if (st = 'P') or (st = 'p') then
kb := true
else
kb := false
end;
end;
end;
end.