Umístnení souboru www.TrSek.com/pas/hanojvez.pas

{ 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.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com