program pyatnashk;
uses GraphABC;
var m:array[1..15] of string;
    res:array[1..15] of string;
    che:array[1..15] of boolean;
    check:boolean;
    num,j:integer;
    
procedure search;begin;
  var um:=0;
  j:=0;check:=false;
  for var i:=1 to 15 do res[i]:=m[i];
  for var i:=1 to 15 do che[i]:=false;
  for var i:=1 to 14 do if res[i]=inttostr(i) then che[i]:=true;
  for var i:=1 to 14 do if che[i]=true then j:=j+1;
  if j=14 then begin
    while check<>true do begin
      um:=um+1;
      if res[um]='empty' then check:=true;
    end;
    m[um]:='15';
  end;
end;
    
procedure init;begin;
  check:=false;
  num:=random(15)+1;
  
  for var i:=1 to 15 do m[i]:=inttostr(i);
  
  for var i:=1 to 15 do begin
    res[i]:=m[i];
    if i=num then check:=true;
    if check=true then begin
      if i=num then res[i]:='empty';
      if i<>num then res[i]:=m[i-1];
    end;
  end;
  
  for var i:=1 to 15 do m[i]:=res[i];
  
  //for var i:=1 to 150 do swap(m[random(15)+1],m[random(15)+1]);
  //for var i:=1 to 15 do writeln(m[i]);

end;

procedure draw;begin;
  var k:=0;
  LockDrawing;
  Window.Clear;
  
  for var i:=1 to 3 do begin
    for var j:=1 to 5 do begin
      k:=k+1;
      rectangle((i*50)-25,(j*50)-25,(i*50)+25,(j*50)+25);
      if m[k]<>'empty' then textout((i*50),(j*50),m[k]);
    end;
  end;
  
  Redraw;
  
end;

procedure move(ch:string);begin;
  var um:=0;
  var chh:=false;

  if ch='up' then begin
    repeat
      um:=um+1;
      if m[um]='empty' then chh:=true;
    until chh=true;
    if um<>1 then if um<>6 then if um<>11 then swap(m[um],m[um-1]);
  end;
  
  if ch='down' then begin
    repeat
      um:=um+1;
      if m[um]='empty' then chh:=true;
    until chh=true;
    if um<>5 then if um<>10 then if um<>15 then swap(m[um],m[um+1]);
  end;
  
  if ch='right' then begin
    repeat
      um:=um+1;
      if m[um]='empty' then chh:=true;
    until chh=true;
    if um<11 then swap(m[um],m[um+5]);
  end;
  
  if ch='left' then begin
    repeat
      um:=um+1;
      if m[um]='empty' then chh:=true;
    until chh=true;
    if um>5 then swap(m[um],m[um-5]);
  end;

end;

procedure KeyDown(Key: integer);begin;
 case Key of
  VK_Left:  move('left');
  VK_Right: move('right');
  VK_Up:    move('up');
  VK_Down:  move('down');
 end;
end;

procedure initanim;begin;
  var q:array[1..4] of string;
  q[1]:='up';
  q[2]:='down';
  q[3]:='right';
  q[4]:='left';
  textout(100,10,'ЗАПОМНИ НАЧАЛЬНУЮ РАССТАНОВКУ!!1!1!!!!!!1111 ');
  Redraw;
  sleep(3000);
  for var i:=1 to 150 do begin
    move(q[random(4)+1]);
    draw;
    sleep(75);
  end;

end;
    
begin
  init;draw;initanim;
  
  while 0=0 do begin
  
    draw;
    OnKeyDown := KeyDown;
    search;
    
  end;
  
end.