{ LOYD15.PAS } { } { Author: Vav } { Date : 15.02.1997 http://www.trsek.com } 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.