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.