Program vyrieši a v grafickom režime presun hanojských veží a rešienie názorne vykreslí

{ HANOJSKE_VEZE_RESOLVE.PAS                                         }
{ Program vyriesi a v grafickom rezime vykresli.                    }
{                                                                   }
{ Datum:16.07.2013                             http://www.trsek.com }
 
program HanojKresli;
uses crt, graph;
 
var i:integer;                          { pomocna }
    n:integer;                          { pocet diskov }
 
    d,od,kam:integer;                   { urcuju presun }
    p:array[1..3,1..8] of byte;         { pole diskov }
   pk:array[1..3,1..8] of byte;         { pole diskov pre kreslenie }
   pt:integer;                          { pocet tahov }
 
 gd,gm: integer;                        { pre graficku kartu }
  text: string;                         { vypis na obrazovku }
 
 
{ mocnina cisla (2^n) }
function mocnina_dvoch(moc:integer):longint;
var vys:longint;
begin
  vys:=1;
 
  for i:=1 to moc do
    vys:=vys*2;
 
  mocnina_dvoch:=vys;
end;
 
 
{ urci disk - kolko krat je delitelny 2 - take je cislo }
function GetDisk(i:integer):integer;
var disk:integer;
begin
 disk:=1;
 
 while((i mod 2) = 0) do
  begin
    i:=i div 2;
    disk:=disk+1;
  end;
 
  { cislo disku }
  GetDisk:=disk;
end;
 
 
{ odkial ma preniest }
{ najde kde sa nachadza tento kruzok }
function GetOd(d:integer):integer;
var x:integer;
begin
  for x:=1 to 3 do
    if p[x,d]=1 then
     begin
       p[x,d]:=0;
       GetOd:=x;
     end;
end;
 
 
{ kam ma preniest }
function GetKam(d,od,n:integer):integer;
var   y:integer;
  k1,k2:integer;
begin
  k1:=od+1;  if(k1>3)then k1:=k1-3;
  k2:=od+2;  if(k2>3)then k2:=k2-3;
 
  { je to tu mozne ? }
  for y:=1 to d do
    if(k1>0)then
      if(p[k1,y]=1)then
         k1:=0;
 
  for y:=1 to d do
    if(k2>0)then
      if(p[k2,y]=1)then
         k2:=0;
 
  { ak mam na vyber beriem podla parnosti }
  if((n mod 2)=1)then
   begin
    if( k2>0 )then
        k1:=k2;
   end
  else
   begin
    if( k1=0 )then
        k1:=k2;
   end;
 
  { vysledok }
  p[k1,d]:=1;
  GetKam:=k1;
end;
 
 
{ pociatocne zaplnenie }
procedure Start;
var x,y:integer;
begin
  { znuluje }
  for x:=1 to 3 do
    for y:=1 to n do
       p[x,y]:=0;
 
  { zaplni prvy stlpec }
  for y:=1 to n do
    p[1,y]:=1;
 
  { znulujem aj pre kreslenie }
  for x:=1 to 3 do
    for y:=1 to 8 do
       pk[x,y]:=0;
 
  { znulujem pocet tahov }
  pt:=0;
end;
 
 
{ vykresli jednotlive stlpy }
procedure Stlpy;
begin
  SetFillStyle(SolidFill, Brown);
  bar(130,100,160,250);
  bar(290,100,320,250);
  bar(450,100,480,250);
  outtextxy(140,80,'A');
  outtextxy(300,80,'B');
  outtextxy(460,80,'C');
end;
 
 
{ na zadanej palicke vykresli disk }
procedure Disk(pol: integer; d: integer; view: boolean);
var   i: integer;
    x,y: integer;
    poz: integer;       { pozicia }
begin
  { ideme dvihnut }
  if( view = false )then begin
     for i:=8 downto 1 do
       if( pk[pol,i] <> 0 )then
            poz:=i;
 
       pk[pol,poz]:=0;
   end
  { ideme polozit }
  else begin
     for i:=1 to 8 do
       if( pk[pol,i] = 0 )then
            poz:=i;
 
       pk[pol,poz]:=d;
   end;
 
  { ideme zobrazit alebo zhasit }
  if( view = false )then
      SetFillStyle(EmptyFill, Blue)
  else
      SetFillStyle(SolidFill, Yellow);
 
  { stlpik zacina tu }
  x:=130+(pol-1)*160;
  y:=poz*16+100;
 
  { vykresli zlava }
  bar(x-(d*8),y,x-1,y+15);
 
  { vykresli zlava }
  bar(x+30+1,y,x+30+(d*8),y+15);
end;
 
 
{ konvertuje cislo na text }
function ToStr(i:integer): string;
var s: string;
begin
  Str(i,s);
  ToStr:=s;
end;
 
procedure EGAVGA_dr; external;
{$L EGAVGA.OBJ }
 
begin
  clrscr;
  write('Automaticky riesitel Hanojskych vezi. Zadaj pocet kruzkov n (max 8):');
  readln(n);
 
  { otvori graficku kartu }
  DetectGraph(gd, gm);
  RegisterBGIdriver(@egavga_dr);
 
  InitGraph(gd, gm,' ');
  if GraphResult <> grOk then
    begin
     writeln('Chyba mi subor egavga.bgi');
    end;
 
  { zmaze obrazovku }
  SetBkColor(Blue);
  ClearDevice;
  outtextxy(50,10,'Automaticky riesitel Hanojskych vezi');
 
  { zaplni premene }
  Start;
 
  { nakresli stlpy }
  Stlpy;
  { vykresli disky }
  for i:=n downto 1 do
    Disk(1, i, true);
 
  { v cykle vykresli }
  for i:=1 to mocnina_dvoch(n)-1 do
   begin
    d:=GetDisk(i);
 
    { vyberie }
    od :=GetOd(d);
    kam:=GetKam(d,od,n);
    inc(pt);
 
    { vykresli }
    Disk(od, d, false);
    Disk(kam, d, true);
 
    { vykresli text }
    SetFillStyle(EmptyFill, Blue);
    bar(10,360, 630,470);
    text:='Tah '+ ToStr(pt) +': preneseny disk '+ chr(d+48) + ' z ' + chr(od+64) + ' na ' + chr(kam+64);
    outtextxy(10,380, text);
    outtextxy(10,400,'Stlac Enter');
    readkey;
 
   end;
 
  outtextxy(10,420,'Hotovo');
  readln;
  closegraph;
end.