Hra Hanojských veží na presunutie krúžkov z prvého stĺpu na tretí

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: KMP (Programy mladých programátorů)
henoj.pngAutor: Miroslav Lízal, Tomáš Okurek
web: pascalweb.wz.cz/index86.html

Program: Henoj.pas
Soubor exe: Henoj.exe

Hra Hanojských veží na presunutie krúžkov z prvého stĺpu na tretí.
{ HENOJ.PAS              Copyright (c) Miroslav Lízal, TomᚠOkurek }
{ Hra Hanojskych vezi na presunutie kruzkov z prveho stlpu na treti.}
{                                                                   }
{ Datum:25.04.2003                             http://www.trsek.com }
 
program penize;
uses crt;
type grafika=array[0..8] of string;
type pole=array[1..8] of integer;
var g:grafika;
var p1,p2,p3:pole;
var i,o,k,s1,s2,s3:integer;
var oco,kco,cotamje,pocett:integer;
 
procedure prehazuj;
begin
 clrscr;
 for i:=7 downto 1 do writeln(g[p1[i]],' ',g[p2[i]],' ',g[p3[i]]);
 writeln('---------------  ---------------  ---------------');
 writeln('Pocet tahu: ',pocett);
 
 repeat
  write('Odkud ');
  read(o);
 until (o=1)or(o=2)or(o=3);
 
 repeat
  write('Kam   ');
  read(k);
 until (o=1)or(o=2)or(o=3);
 
 case o of
     1: oco:=p1[s1];
     2: oco:=p2[s2];
     3: oco:=p3[s3];
     end;
 case k of
     1: cotamje:=p1[s1];
     2: cotamje:=p2[s2];
     3: cotamje:=p3[s3];
     end;
 
 if (cotamje>oco)or(cotamje=0) then begin
 
                     case o of
                      1: begin oco:=p1[s1]; s1:=s1-1;p1[s1+1]:=0;end;
                      2: begin oco:=p2[s2]; s2:=s2-1;p2[s2+1]:=0;end;
                      3: begin oco:=p3[s3]; s3:=s3-1;p3[s3+1]:=0;end;
                     end;
 
                     case k of
                      1: begin p1[s1+1]:=oco; s1:=s1+1;end;
                      2: begin p2[s2+1]:=oco; s2:=s2+1;end;
                      3: begin p3[s3+1]:=oco; s3:=s3+1;end;
                     end;
                     pocett:=pocett+1;
 
                    end;
 if ((p3[1]=7) and (p3[2]=6) and (p3[3]=5) and (p3[4]=4) and (p3[5]=3) and (p3[6]=2) and (p3[7]=1)) then
 else prehazuj;
end;
 
begin
 for i:=1 to 7 do p1[i]:=7+1-i;
 for i:=1 to 7 do p2[i]:=0;
 for i:=1 to 7 do p3[i]:=0;
 g[0]:='       |        ';
 g[1]:='      Ű1Ű       ';
 g[2]:='     ŰŰ2ŰŰ      ';
 g[3]:='    ŰŰŰ3ŰŰŰ     ';
 g[4]:='   ŰŰŰŰ4ŰŰŰŰ    ';
 g[5]:='  ŰŰŰŰŰ5ŰŰŰŰŰ   ';
 g[6]:=' ŰŰŰŰŰŰ6ŰŰŰŰŰŰ  ';
 g[7]:='ŰŰŰŰŰŰŰ7ŰŰŰŰŰŰŰ ';
 
 s1:=7;
 prehazuj;
 write('Konec');
 delay(2500);
end.