iforum

má niekto pls zdrojový kód tohto programu?

Napíšte program, ktorý vám umožní hrať hru ŽABKY. Používateľ si zvolí počet žabiek N (žabky sú reprezentované číslami 1..N). Žabky sa náhodne posadia na kamene v rieke (kameňov je o jeden viac ako žabiek). Úlohou hráča je usporiadať ich od čísla 1 po číslo N, pričom prvý kameň zostane prázdny. Žabky nevedia skákať na ľubovoľnú vzdialenosť, dokážu preskočiť len na susedný kameň, ak je voľný, alebo preskočiť jednu žabku, t. j. skočiť na kameň, od ktorého ich delí len jeden iný kameň. Používateľ si stlačením príslušného čísla vyberie žabku. Ak si vybral žabku, ktorá nemá možnosť preskočiť, nestane sa nič, ak má žabka možnosť premiestniť sa, tak to urobí. Hra skončí uložením žabiek, alebo stlačením klávesu ESC.

{okomentuj riadky}
uses crt;
const m=10;
var z:array[1..m] of byte;
var i,n,akt,akt0,cc:integer;
ulozene:boolean;
c:char;
procedure zamiesaj;
var rovnake:boolean;
j:byte;
pom,p,d:byte;
begin
randomize;
for i:=1 to n do z[i]:=i-1;
for i:=1 to n do
begin
p:=random(n-1)+1;
d:=random(n-1)+1;
if p<>d then begin pom:=z[p];z[p]:=z[d];z[d]:=pom end;
end;
i:=1;
while z[i]<>0 do i:=i+1;
akt0:=i;
end;
procedure ulozenep;
begin
ulozene:=true;i:=0;
while (i<n) and ulozene do
begin
i:=i+1;
if z[i]<>(i-1) then ulozene:=false;
end;
if not ulozene then
begin
ulozene:=true;i:=0;
while (i<n-1) and ulozene do
begin
i:=i+1;
if z[i]<>i then ulozene:=false;
end;
end;
end;
procedure kde;
begin
i:=1;
while (z[i]<>cc) and (i<=n) do i:=i+1;
akt:=i;
end;
procedure posunvl;
begin
if (akt-akt0=1) or (akt-akt0=2)then
begin
z[akt0]:=z[akt];
z[akt]:=0;
akt0:=akt;
end
else
begin
gotoxy(30,7);
write('Ja tak daleko nedoskocim.');
delay(500)
end;

end;
procedure posunvp;
begin
if (akt0-akt=1) or (akt0-akt=2)then
begin
z[akt0]:=z[akt];
z[akt]:=0;
akt0:=akt;
end
else
begin
gotoxy(30,7);
write('Ja tak daleko nedoskocim.');
delay(500);
end;
end;
procedure nakresli;
var x:byte;
begin
clrscr;
x:=0;
for i:=1 to n do
begin
x:=x+(80 div (n+1));
gotoxy(x,13);
if z[i]<>0 then
begin
textattr:=16*green+red;
write(z[i])
end;
textattr:=7;
gotoxy(x-1,14);
write('ZZZ');
end;
textattr:=15;
end;
begin
textattr:=15;
clrscr;
write('Zadaj pocet zabiek: ');
readln(n);
n:=n+1;
ulozene:=false;
zamiesaj;
repeat
nakresli;
c:=readkey;
cc:=ord(c)-ord('0');
kde;
if (cc>0) and (cc<n) then
if akt>akt0 then posunvl else posunvp;
ulozenep
until ulozene or (c=#27);
nakresli;
if ulozene then
begin
gotoxy(30,7);
write('Hotovo. Gratulujem.');
end
else
begin
gotoxy(30,7);
write('Skoda, ze koncis.');
end;
readkey
end.

presne aj ja potrebujem toto..vďaka