program loyd15;
uses crt,dos,graph;
var loyd:array[1..4,1..4] of integer;
gd,gm,xp,yp:integer;
x,y:integer;
pocet,oldpocet:integer;
ch:char;
s:string;
Procedure zamiesaj;
var x,y,i:integer;
ok:boolean;
begin
for x:=1 to 4 do for y:=1 to 4 do loyd[x,y]:=0;
for i:=1 to 15 do begin
x:=random (4)+1;
y:=random (4)+1;
ok:=false;
repeat
if loyd[x,y]=0 then begin
ok:=true;
loyd[x,y]:=i;
end;
if not(ok) and (x<4) then begin
x:=x+1;
if loyd [x,y]=0 then begin
ok:=true;
loyd[x,y]:=i;
end;
end;
if not(ok) and (x=4) and (y<4) then begin
x:=1;
y:=y+1;
if loyd[x,y]=0 then begin
ok:=true;
loyd[x,y]:=i;
end;
end;
if not(ok) and (x=4) and (y=4) then begin
x:=1;
y:=1;
if loyd[x,y]=0 then begin
ok:=true;
loyd[x,y]:=i;
end;
end;
until ok;
end;
end;
procedure policko (x,y:integer);
var s:string[4];
i:integer;
begin
setcolor(green);
setfillstyle (11,lightgray);
bar (25+(x-1)*110,25+(y-1)*110,25+(x-1)*110+100,25+(y-1)*110+100);
for i:=0 to 3 do begin
setcolor(darkgray);
line(25+(x-1)*110-i,25+(y-1)*110-i,25+(x-1)*110-i,25+(y-1)*110+100-i);
line(25+(x-1)*110-i,25+(y-1)*110-i,25+(x-1)*110+100-i,25+(y-1)*110-i);
setcolor(white);
line(25+(x-1)*110+100-i,25+(y-1)*110-i,25+(x-1)*110+100-i,25+(y-1)*110+100-i);
line(25+(x-1)*110-i,25+(y-1)*110+100-i,25+(x-1)*110+100-i,25+(y-1)*110+100-i);
end;
setcolor (14);
if loyd[x,y]<>0 then begin
str (loyd[x,y],s);
outtextxy(50+(x-1)*110,40+(y-1)*110,s);
end;
end;
procedure vykresli;
var x,y:integer;
begin
setfillstyle (1,green);
bar (15,15,470,470);
for x:=1 to 4 do for y:=1 to 4 do policko(x,y);
setcolor(yellow);
setfillstyle (11,lightgray);
settextstyle(1,0,3);
outtextxy(500,50,'Pocet tahov:');
settextstyle(1,0,5);
end;
function poskladane:boolean;
var x,y,i:integer;
posk:boolean;
begin
posk:=true;
x:=0;
y:=1;
i:=0;
repeat
x:=x+1;
i:=i+1;
if x>4 then begin
x:=1;
y:=y+1;
end;
if loyd[x,y]<>i then posk:=false;
until (posk =false);
if (x=4) and (y=4) and (loyd[4,4]=0) then posk:=true;
poskladane:=posk;
end;
begin
randomize;
detectgraph(gd,gm);
initgraph (gd,gm,'');
repeat
cleardevice;
settextstyle(1,0,5);
zamiesaj;pocet:=0;
for x:=1 to 4 do for y:=1 to 4 do begin
if loyd[x,y]=0 then begin
xp:=x;
yp:=y;
end;
end;
vykresli;
repeat
if keypressed then ch:=readkey;
if ch=#0 then begin
ch:=readkey;
if (ch=#75) and (xp<4) then begin
loyd[xp,yp]:=loyd[xp+1,yp];
loyd[xp+1,yp]:=0;
policko (xp,yp);
xp:=xp+1;inc(pocet);
policko (xp,yp);
end;
if (ch=#77) and (xp>1) then begin
loyd[xp,yp]:=loyd[xp-1,yp];
loyd[xp-1,yp]:=0;
policko (xp,yp);
xp:=xp-1;inc(pocet);
policko (xp,yp);
end;
if (ch=#80) and (yp>1) then begin
loyd[xp,yp]:=loyd[xp,yp-1];
loyd[xp,yp-1]:=0;
policko (xp,yp);
yp:=yp-1;inc(pocet);
policko (xp,yp);
end;
if (ch=#72) and (yp<4) then begin
loyd[xp,yp]:=loyd[xp,yp+1];
loyd[xp,yp+1]:=0;
policko (xp,yp);
yp:=yp+1;inc(pocet);
policko (xp,yp);
end;
end;
if pocet<>oldpocet then begin
setfillstyle(1,black);
bar(600,120,680,170);
str(pocet,s);
settextstyle(1,0,3);
outtextxy(600,120,s);
settextstyle(1,0,5);
oldpocet:=pocet;
end;
until (poskladane or (ch=#27));
for x:=1 to 20 do begin sound(random(500));delay(random(40)+1);end;
nosound;
settextstyle(1,0,3);
outtextxy(500,300,'Znova [a/n]');
ch:=readkey;
until not(ch in ['a','A']);
closegraph;
end.