Game tower of Hanoi

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Category: Source in Pascal
hanojvez.pngProgram: Hanojvez.pas
File exe: Hanojvez.exe
File ubuntu: Hanojvez
Example: Hanojvez.txt

Game tower of Hanoi. The challenge is to move the rings from the left column to the right. It must not, however, put more into smaller ring. It is always possible to take only one ring.
{ HANOJVEZ.PAS              Copyright (c) TrSek alias Zdeno Sekerak }
{ Hra Hanojske veze. Ulohou je premiestnit kruzky z laveho stlpa    }
{ na pravy. Nesmie sa vsak polozit vacsi kruzok na mensi.           }
{                                                                   }
{ Datum:12.06.2005                             http://www.trsek.com }
 
program hanojske_veze;
 
uses crt,dos;
 
const MAX_VEZ=8;
      HORE=6;
 
var vez:array[1..3,1..MAX_VEZ] of byte;
    poc:byte;
    tah:integer;
 
     ch:char;   { znak pre citania z klavesnice }
    poz:byte;   { pozicia na stlpe              }
    akt:byte;   { sirka aktualneho kruzku       }
    stl:byte;   { cislo stlpu                   }
 
    fin:boolean;
 
 
{ zobrazi pocet tahov }
procedure DalsiTah;
begin
  tah:=tah+1;
 
  TextColor(White);
  gotoxy(44,3);
  write(tah:2);
end;
 
 
{ nakresli podklad }
procedure Podklad;
var stred:byte;
      x,y:integer;
begin
  gotoxy(2,2); write('Hanojske veze');
  gotoxy(2,3); write('--------------');
  gotoxy(40,2); write('Ovladanie: 1,2,3,ESC');
  gotoxy(40,3); write('Tah:');
  gotoxy(40,4); write('Cas:');
 
  { vykreslime stlpy }
  for x:=1 to 3 do
  begin
    { stred stlpu je }
    stred:=22*x-5;
    gotoxy(stred,HORE+1); write('+-+');
 
    { spodok stlpu }
    gotoxy(stred-MAX_VEZ-1,MAX_VEZ*2+HORE+2);
    write('---------+ +---------');
 
    {}
    for y:=1 to MAX_VEZ do
      begin
        gotoxy(stred,y*2+HORE  ); write('| |');
        gotoxy(stred,y*2+HORE+1); write('| |');
      end;
  end;
end;
 
 
{ nakresli kruzok }
procedure Kruzok(stl,poz:byte; clr:boolean);
var akt:byte;
  stred:byte;
      i:integer;
begin
  { o aky kruzok sa jedna }
  akt:=vez[stl,poz];
 
  if(clr)then TextColor(Black+akt)
         else TextColor(Black);
 
  { stred stlpu je }
  stred:=22*stl-4;
 
  { vykresli kruzok }
  for i:=2 to akt+2 do
  begin
    gotoxy(stred-i, poz*2+HORE  ); write('#');
    gotoxy(stred-i, poz*2+HORE+1); write('#');
    gotoxy(stred+i, poz*2+HORE  ); write('#');
    gotoxy(stred+i, poz*2+HORE+1); write('#');
  end;
end;
 
 
{ definuje a vykresli zaciatok }
procedure Zacni(poc:integer);
var y:byte;
begin
  for y:=MAX_VEZ-poc+1 to MAX_VEZ do
  begin
    vez[1,y]:=y;
    Kruzok(1,y,true);
  end;
end;
 
 
{ da poziciu najvyssieho kruzku }
function DajKruzok(stl:byte):byte;
var i:byte;
begin
  DajKruzok:=0;
 
  for i:=MAX_VEZ downto 1 do
    if( vez[stl,i]<>0 )then
        DajKruzok:=i;
end;
 
 
{ polozi na najblizsiu volnu poziciu }
procedure PolozKruzok(stl,krz:byte);
var i:byte;
begin
  i:=MAX_VEZ;
 
  while( vez[stl,i]<>0 ) do
    i:=i-1;
 
  { najdena pozicia }
  vez[stl,i]:=krz;
end;
 
 
{ zistime ci vyhovuje podmienke }
function Vyhovuje(stl,akt:byte):boolean;
var naj:byte;
begin
  { zistime najvyssi }
  Vyhovuje:=true;
  naj:=DajKruzok(stl);
 
  { kedy nevyhovuje }
  if( naj<>0 )then
   if( vez[stl,naj]<akt )then
       Vyhovuje:=false;
end;
 
 
{ vyhovuje podmienke pre koniec }
{ staci otestovat len 1 kruzok }
function Koniec:boolean;
begin
  if( vez[3,MAX_VEZ-poc+1] = (MAX_VEZ-poc+1))then
      Koniec:=true
  else
      Koniec:=false;
end;
 
 
{ hlavny begin-end }
begin
  ClrScr;
 
  poc:=4;
  Podklad;
  Zacni(poc);
 
  akt:=0;
  tah:=0;
  fin:=false;
 
  { cyklus presuvania }
  repeat
    ch:=readkey;
    if( ch in ['1','2','3'])then
    begin
 
      { ak este nieje dvihnuty kruzok }
      if( akt=0 )then
       begin
        { aktualne najvyssie }
        stl:=ord(ch)-ord('0');
        poz:=DajKruzok(stl);
 
        if( poz<>0 )then
        begin
           { zmaze na obrazovke }
           Kruzok(stl,poz, false);
 
           { presunie v pameti }
           akt:=vez[stl,poz];
           vez[stl,1]:=akt;
           vez[stl,poz]:=0;
 
           { vykresli - hore }
           Kruzok(stl,1, true);
           DalsiTah;
        end;
 
       end
      else
       { polozim zdvihnuty kruzok ak sa da }
       if( Vyhovuje(ord(ch)-ord('0'),akt))then
       begin
        { zmaze }
        Kruzok(stl,1, false);
        akt:=vez[stl,1];
        vez[stl,1]:=0;
 
        { polozi na novu poziciu }
        stl:=ord(ch)-ord('0');
        PolozKruzok(stl,akt);
 
        { vykrseli kde je teraz kruzok }
        poz:=DajKruzok(stl);
        Kruzok(stl,poz, true);
 
        akt:=0;
        DalsiTah;
        fin:=Koniec;
       end;
    end;
 
  until (ch=#27) or fin;
end.