old/PAS/Ways/WAY.PAS

uses CRT;
const
  XS = 10;
  YS = 10;

var
  Lab : array [0..YS+1,0..XS+1] of byte;
  Out : array [1..YS,1..XS] of char;
  inp,outp : text;
  i,j : byte;
  buf : string;
  StX,StY,EnX,EnY : byte;

Procedure WrB;
begin
  write('É');
	FOR j := 1 to XS do write('Í');
  writeln('»');
  FOR i := 1 to YS do
  begin
    write('º');
    for j := 1 to XS do Write(out[i,j]);
    writeln('º');
  end;
  write('È');
	FOR j := 1 to XS do write('Í');
  write('¼');
end;

procedure SetNums(x,y,ch : byte);
begin
  if (lab[y,x] <= ch) and (lab[y,x]<>0) then exit;
  if  lab[y,x] = 1 then exit;
  lab[y,x] := ch;
  if X < XS then SetNums(x+1,y,ch+1);
  if Y < YS then SetNums(x,y+1,ch+1);
  if X > 1  then SetNums(x-1,y,ch+1);
  if Y > 1  then SetNums(x,y-1,ch+1);
end;


begin
  clrscr;
  assign(inp,'input.txt');reset(inp);
  fillchar(lab,XS*YS,255);
  for j := 1 to YS do
  begin
    ReadLn(inp,buf);
    for i := 1 to XS do Lab[j,i] := ord(buf[i])-$30;
  end;
  ReadLn(inp,StX,StY,EnX,EnY);
  if (StX=EnX) and (STY=EnY) then Begin WriteLn('Œ àèàãâ ¯ãáâ!'); Halt(255);end;
  for i := 1 to YS do for j:=1 to XS do if lab[i,j] = 1 then out[i,j] := 'Û';
  SetNums(StX,StY,2);
  i := enX;
  j := enY;

  while (i <> stX) or (j<>stY) do
   begin
     if lab[j+1,i] = lab[j,i]-1 then begin out[j,i] := #24;inc(j);Continue;end;
     if lab[j,i+1] = lab[j,i]-1 then begin out[j,i] := #27;inc(i);Continue;end;
     if lab[j-1,i] = lab[j,i]-1 then begin out[j,i] := #25;dec(j);Continue;end;
     if lab[j,i-1] = lab[j,i]-1 then begin out[j,i] := #26;dec(i);Continue;end;
     WriteLn('‚ë室  �…’!');
     Halt(255);
   end;

  out[j,i] := 'S';
  out[enY,enX] := 'F';

  WrB;
  WriteLn;
  WriteLn;
  ReadKey;
end.