Hra Loyd 15 v pascale v grafickej podobe

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