Алгоритм волны. Проход конем шахматной доски.

program lab;
 
uses
 crt;
type
 tBoard=array [0..11,0..11] of integer;
 tWay=array [1..122,1..2] of integer;
 
procedure create(var board:tBoard);
 var
  i,j:integer;
 begin
  for i:=0 to 11 do
   begin
    for j:=0 to 1 do
     begin
      board[j,i]:=-1;
      board[i,j]:=-1;
     end;
    for j:=10 to 11 do
     begin
      board[j,i]:=-1;
      board[i,j]:=-1;
     end
   end;
 end;
 
procedure enter(var x,y:integer);
 begin
  writeln('enter the coordinates');
  readln(x,y);
  while (x<1) or (x>8) or (y<1) or (y>8) do
   begin
    writeln('illegal coordinates');
    writeln;
    writeln('enter coordinates again');
    readln(x,y);
   end;
  x:=x+1;
  y:=y+1;
 end;
 
procedure wall(var board:tBoard);
 var
  x,y:integer;
 begin
  clrscr;
  writeln('now you should enter the coordinate of the cut filds');
  repeat
   begin
    enter(x,y);
    board[x,y]:=-1;
    clrscr;
    writeln('if it''s all, click esc, else click any other button');
   end
  until readkey=#27;
 end;
 
procedure paint (board:tBoard);
 var
  i,j:integer;
 begin
  for i:=2 to 9 do
   begin
    for j:=2 to 9 do
     begin
      case board[i,j] of
       -1:    write(' # ');
       0:     write(' . ');
      end;
     end;
    writeln
   end
 end;
 
procedure paint2 (board:tBoard; startX,startY,finishX,finishY:integer);
 var
  i,j:integer;
 begin
  for i:=2 to 9 do
   begin
    for j:=2 to 9 do
     begin
      if (i=startX) and (j=startY) then
       write(' s ')
      else
       begin
        if (i=finishX) and (j=finishY) then
         write(' f ')
        else
         case board[i,j] of
          -1:    write(' # ');
          32000: write(' * ');
          else   write(' . ');
         end;
       end;
     end;
    writeln
   end
 end;
 
 
procedure wave(var board:tBoard; startx,starty,finishx,finishy:integer);
 var
  k,x,y:integer;
  flag:boolean;
 begin
  board[startX,startY]:=1;
  k:=1;
  flag:=true;
  while flag do
   begin
    flag:=false;
     for x:=2 to 9 do
      for y:=2 to 9 do
       if board[x,y]=k then
        begin
         if board[x+1,y+2]=0 then
          begin
           board[x+1,y+2]:=k+1;
           flag:=true;
          end;
         if board[x+2,y+1]=0 then
          begin
           board[x+2,y+1]:=k+1;
           flag:=true;
          end;
         if board[x+2,y-1]=0 then
          begin
           board[x+2,y-1]:=k+1;
           flag:=true;
          end;
         if board[x+1,y-2]=0 then
          begin
           board[x+1,y-2]:=k+1;
           flag:=true;
          end;
         if board[x-1,y-2]=0 then
          begin
           board[x-1,y-2]:=k+1;
           flag:=true;
          end;
         if board[x-2,y-1]=0 then
          begin
           board[x-2,y-1]:=k+1;
           flag:=true;
          end;
         if board[x-2,y+1]=0 then
          begin
           board[x-2,y+1]:=k+1;
           flag:=true;
          end;
         if board[x-1,y+2]=0 then
          begin
           board[x-1,y+2]:=k+1;
           flag:=true;
          end;
        end;
       if board[finishx,finishy]>0 then
        flag:=false
       else
        k:=k+1
   end
 end;
 
procedure toWay(var board:tBoard; var Way:tWay; x,y:integer; var Step,k:integer);
 begin
  way[step,1]:=x;
  way[step,2]:=y;
  step:=step+1;
  k:=k-1;
  Board[x,y]:=32000;
 end;
 
procedure path(finishX,finishY:integer; var board:tBoard; var Way:tWay);
 var
  step,k,x,y:integer;
 begin
  step:=1;
  way[step,1]:=finishX;
  way[step,2]:=finishY;
  k:=board[finishX,finishY]-1;
  x:=finishX;
  y:=finishY;
  while k>0 do
   begin
    if board[x+1,y+2]=k then
     begin
      x:=x+1;
      y:=y+2;
      toWay(board,Way,x,y,step,k);
     end;
    if board[x+2,y+1]=k then
     begin
      x:=x+2;
      y:=y+1;
      toWay(board,Way,x,y,step,k);
     end;
    if board[x+2,y-1]=k then
     begin
      x:=x+2;
      y:=y-1;
      toWay(board,way,x,y,step,k);
     end;
    if board[x+1,y-2]=k then
     begin
      x:=x+1;
      y:=y-2;
      toWay(board,Way,x,y,step,k);
     end;
    if board[x-1,y-2]=k then
     begin
      x:=x-1;
      y:=y-2;
      toWay(board,way,x,y,step,k);
     end;
    if board[x-2,y-1]=k then
     begin
      x:=x-2;
      y:=y-1;
      toWay(board,way,x,y,step,k);
     end;
    if board[x-2,y+1]=k then
     begin
      x:=x-2;
      y:=y+1;
      toWay(board,way,x,y,step,k);
     end;
    if board[x-1,y+2]=k then
     begin
      x:=x-1;
      y:=y+2;
      toWay(board,way,x,y,step,k);
     end;
   end
 end;
 
var
 board:tBoard;
 way:tway;
 startx,starty,finishx,finishy:integer;
 i,f,j:integer;
begin
 create(board);
 clrscr;
 wall(board);
 clrscr;
 writeln('now you should enter the coordinates of beginning of the path');
 enter(startx,starty);
 while board[startx,starty]=-1 do
  begin
   writeln('you have chosen the cut field, try again');
   writeln;
   enter(startx,starty);
  end;
 clrscr;
 writeln('now you should enter the coordinates of endinging of the path');
 enter(finishx,finishy);
 while board[finishx,finishy]=-1 do
  begin
   writeln('you have chosen the cut field, try again');
   writeln;
   enter(finishx,finishy);
  end;
 clrscr;
 writeln('the board has the form:');
 writeln;
 paint(board);
 writeln;
 writeln('for searching the pass click enter');
 readln;
 wave(board,startx,starty,finishx,finishy);
 clrscr;
 if board[finishX,finishY]>0 then
  begin
   path(finishx,finishy,board,way);
   paint2(board,startX,startY,finishX,finishY);
   writeln('sequence of moves:');
   i:=122;
   while way[i,1]=0 do
    i:=i-1;
   f:=1;
   for j:=i downto 1 do
    begin
     writeln('step ',f,': (',way[j,1],',',way[j,2],')');
     f:=f+1
    end
  end
 else
  writeln('mission impossible, sorry');
 
 readln
end.