Ханойские башни, с использованием графики Опции

[Rediska]

см. Ханойские башни ( http://forum.pascalnet.ru/index.php?showtopic=9254 )
(сообщение отредактировал Altair)

Здрасте,
мне бы програмку,
Ханойские башни, с графикой. Наверно это большая программа-считай игра получается, но может кто уже делал чтото подобное?

Честно признаюсь сама даже не начинала - глупая я.
чтонибудь как можно проще- вводишь с какой башни на какую хочешь перекинуть колечко, и тебе показывают картинку, что получилось в результате.

вот такой код нашла в вашем топике про рекурию, не рекурсивное решение было тоже, но мне я думаю рекурсивное подойдет больше?,может это както поможет?

Код

Program Hanoj;
Const k = 3;
Var a,b,c : Char;
Procedure Disk(n : Integer; a, b, c: Char);
Begin
if n>0 then
    begin
      Disk(n-1,a,c,b);
      Writeln(‘Диск ‘,n, ’ c ‘, a,’->’, b);
      Disk(n-1,c,b,a);
    end;
End;
BEGIN
a := ‘A’; b := ‘B’; c := ‘C’;
Disk(k,a,b,c);
ReadLn;
END.

если возможно напишите полное решение (максимално простое-примитивное), если нет, то любая помошь приветствуется
заранее благодарна

[fms]

как то недавно нашла в инете. чье - не смогу сказать. работает или нет не проверяла.

попробуй.

Код

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^.no<top3^.no) then
              begin
                son:=top1^.no;  str(son,cevir);
                Push(pop(top1),top3); control:=10;
                yazdir;
              end;
           if (tekmi(top1^.no)=2)and(top1^.no<top2^.no)and(control=0) then
              begin
                son:=top1^.no; str(son,cevir);
                Push(pop(top1),top2); control:=10;
                yazdir;
              end;
         end;


      if (top2<>nil)and(top2^.no<>son)and(control=0) then
         begin
           if (tekmi(top2^.no)=1)and(top2^.no<top1^.no) then
              begin
                son:=top2^.no;   str(son,cevir);
                Push(pop(top2),top1); control:=10;
                yazdir;
              end;
           if (tekmi(top2^.no)=2)and(top2^.no<top3^.no)and(control=0) then
              begin
                son:=top2^.no;    str(son,cevir);
                Push(pop(top2),top3); control:=10;
                yazdir;
              end;
         end;


      if (top3<>nil)and(top3^.no<>son)and(control=0) then
         begin
           if (tekmi(top3^.no)=1)and(top3^.no<top2^.no) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top2); control:=10;
                yazdir;
              end;
           if (tekmi(top3^.no)=2)and(top3^.no<top1^.no)and(control=0) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top1); control:=10;
                yazdir;
              end;
         end;
      control:=0;
      counter:=counter+1;
      str(counter,cevir);
      outtextxy(20,370,'Number of move :');outtextxy(150,370,cevir);
      readkey;
      until deger=counter;
                     end;


  if tekmi(n)=2 then begin
    repeat
      if (top1<>nil)and(top1^.no<>son) then
         begin
           if (tekmi(top1^.no)=1)and(top1^.no<top2^.no) then
              begin
                son:=top1^.no;  str(son,cevir);
                Push(pop(top1),top2); control:=10;
                yazdir;
              end;
           if (tekmi(top1^.no)=2)and(top1^.no<top3^.no)and(control=0) then
              begin
                son:=top1^.no;  str(son,cevir);
                Push(pop(top1),top3); control:=10;
                yazdir;
              end;
         end;


      if (top2<>nil)and(top2^.no<>son)and(control=0) then
         begin
           if (tekmi(top2^.no)=1)and(top2^.no<top3^.no) then
              begin
                son:=top2^.no;  str(son,cevir);
                Push(pop(top2),top3); control:=10;
                yazdir;
              end;
           if (tekmi(top2^.no)=2)and(top2^.no<top1^.no)and(control=0) then
              begin
                son:=top2^.no;  str(son,cevir);
                Push(pop(top2),top1); control:=10;
                yazdir;
              end;
         end;


      if (top3<>nil)and(top3^.no<>son)and(control=0) then
         begin
           if (tekmi(top3^.no)=1)and(top3^.no<top1^.no) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top1); control:=10;
                yazdir;
              end;
           if (tekmi(top3^.no)=2)and(top3^.no<top2^.no)and(control=0) then
              begin
                son:=top3^.no;  str(son,cevir);
                Push(pop(top3),top2); control:=10;
                yazdir;
              end;
         end;
      control:=0;
      counter:=counter+1;
      str(counter,cevir);
      outtextxy(20,350,'Number of move :');outtextxy(150,350,cevir);
      readkey;
      until deger=counter;
                     end;
end.

см. Ханойские башни ( http://forum.pascalnet.ru/index.php?showtopic=9254 )

Сообщение отредактировано: Altair - 10.02.2006 12:45