uses crt,graph; type nodeptr=^node; node=record no:integer; next:nodeptr; end; aray20=array[1..20]of byte; var yeni,top1,top2,top3,temp1,temp2,temp3:nodeptr; n,i,tekcift,son,control,sayac1,sayac2,sayac3:byte; source,dest:char; counter,deger:longint; uzun1,uzun2,uzun3:aray20; gd,gm :integer; cevir:string; {-------------------------------------------------------} Procedure Initialize; begin clrscr; top1:=nil; top2:=nil; top3:=nil; tekcift:=0; counter:=1; control:=0; sayac1:=1; sayac2:=1; sayac3:=1; gotoxy(25,2); textcolor(red); write('HANOI TOWERS'); gotoxy(1,4); textcolor(white); writeln(' There are 3 pegs named A,B,C. One peg is source peg,'); writeln('one is destination peg, the other peg is temporary peg.');writeln; writeln(' There are N discs. The smallest disc is disc1 and the '); writeln('largest disc is disc N. There can be maximum 20 discs.');textcolor(red);writeln; write(' GOAL : ');textcolor(white); writeln('All discs will be carried from source peg into'); writeln(' the destination peg.'); writeln;textcolor(red); write(' RULES : 1) ');textcolor(white); writeln('Only one disc can be moved at a time, and'); writeln(' this disc must be the top disc on a peg.');textcolor(red);writeln; write(' 2) ');textcolor(white); writeln('A larger disc can never be placed on top'); writeln(' of a smaller disc.');writeln; writeln(' IT IS NOT A RECURSIVE PROGRAM');writeln; writeln(' Press any key to continue'); readkey;clrscr; repeat write('Enter the N number : ');readln(n); if (n=0)or(n=1)or(n>20) then clrscr; until (n<>0)and(n<>1)and(n<=20); write('Enter the source peg(A,B,C) : ');readln(source); source:=upcase(source); repeat write('Enter the destination peg : ');readln(dest); source:=upcase(source); dest:=upcase(dest); if dest=source then begin gotoxy(28,3); clreol; gotoxy(1,3);end; until dest<>source; detectgraph(gd,gm); initgraph(gd,gm,''); cleardevice; setbkcolor(7); end; {----------------------------------------------------------} Procedure Push(item:integer; var head:nodeptr); begin new(yeni); yeni^.no:=item; yeni^.next:=head; head:=yeni; end; {-----------------------------------------------------------} Function Pop(var head:nodeptr):integer; var temp:nodeptr; begin temp:=head; head:=head^.next; pop:=temp^.no; dispose(temp); end; {-----------------------------------------------------------} Function usalma(a:integer):integer; var i,s:integer; begin s:=1; if a=1 then s:=2 else for i:=1 to n do s:=s*2; usalma:=s-1; end; {-----------------------------------------------------------} Function tekmi(a:integer):byte; begin if a mod 2=1 then tekmi:=1 else tekmi:=2; end; {-----------------------------------------------------------} Procedure ciz(s1,s2,s3:aray20; sa1,sa2,sa3:byte); var i,m1,m2,m3:byte; begin setfillstyle(1,red); m1:=0; m2:=0; m3:=0; setcolor(1); outtextxy(95,325,'A'); outtextxy(295,325,'B'); outtextxy(495,325,'C'); setcolor(red); outtextxy(295,370,'Press any key to continue'); setcolor(yellow); for i:=sa1-1 downto 1 do begin m1:=m1+1; str(s1[i],cevir); bar(85-4*s1[i],313-13*m1,109+4*s1[i],323-13*m1); outtextxy(95,313-13*m1,cevir); end; for i:=sa2-1 downto 1 do begin m2:=m2+1; str(s2[i],cevir); bar(85-4*s2[i]+200,313-13*m2,309+4*s2[i],323-13*m2); outtextxy(295,313-13*m2,cevir); end; for i:=sa3-1 downto 1 do begin m3:=m3+1; str(s3[i],cevir); bar(85-4*s3[i]+400,313-13*m3,509+4*s3[i],323-13*m3); outtextxy(495,313-13*m3,cevir); end; setcolor(red); end; {----------------------------------------------------------} Procedure yazdir; var i:byte; begin cleardevice; sayac1:=1; sayac2:=1; sayac3:=1; temp1:=top1; temp2:=top2; temp3:=top3; while temp1<>nil do begin uzun1[sayac1]:=temp1^.no; temp1:=temp1^.next; sayac1:=sayac1+1; end; while temp2<>nil do begin uzun2[sayac2]:=temp2^.no; temp2:=temp2^.next; sayac2:=sayac2+1; end; while temp3<>nil do begin uzun3[sayac3]:=temp3^.no; temp3:=temp3^.next; sayac3:=sayac3+1; end; if (source='A')and(dest='C') then ciz(uzun1,uzun2,uzun3,sayac1,sayac2,sayac3); if (source='A')and(dest='B') then ciz(uzun1,uzun3,uzun2,sayac1,sayac3,sayac2); if (source='B')and(dest='C') then ciz(uzun2,uzun1,uzun3,sayac2,sayac1,sayac3); if (source='B')and(dest='A') then ciz(uzun3,uzun1,uzun2,sayac3,sayac1,sayac2); if (source='C')and(dest='A') then ciz(uzun3,uzun2,uzun1,sayac3,sayac2,sayac1); if (source='C')and(dest='B') then ciz(uzun2,uzun3,uzun1,sayac2,sayac3,sayac1); end; {-----------------------------------------------------------} begin initialize; for i:=n downto 1 do push(i,top1); yazdir; readkey; if tekmi(n)=1 then begin if tekmi(top1^.no)=1 then push(pop(top1),top3) else push(pop(top1),top2); end else begin if tekmi(top1^.no)=1 then push(pop(top1),top2) else push(pop(top1),top3); end; son:=1; yazdir; outtextxy(20,370,'Number of move : 1'); readkey; deger:=usalma(n); if tekmi(n)=1 then begin repeat if (top1<>nil)and(top1^.no<>son) then begin if (tekmi(top1^.no)=1)and(top1^.nonil)and(top2^.no<>son)and(control=0) then begin if (tekmi(top2^.no)=1)and(top2^.nonil)and(top3^.no<>son)and(control=0) then begin if (tekmi(top3^.no)=1)and(top3^.nonil)and(top1^.no<>son) then begin if (tekmi(top1^.no)=1)and(top1^.nonil)and(top2^.no<>son)and(control=0) then begin if (tekmi(top2^.no)=1)and(top2^.nonil)and(top3^.no<>son)and(control=0) then begin if (tekmi(top3^.no)=1)and(top3^.no