Волновой поиск, реализация на Pascal и C++

Program Voln;

Uses Crt;

Const

     Map : array [1..10, 1..10] of Byte =

         (

                (0, 0, 1, 0, 0, 0, 0, 0, 0, 0),

                (1, 0, 0, 0, 0, 1, 0, 0, 1, 0),

                (0, 0, 0, 1, 1, 1, 0, 0, 1, 1),

                (0, 1, 0, 0, 0, 1, 0, 0, 1, 0),

                (0, 0, 0, 0, 1, 1, 1, 0, 1, 0),

                (0, 0, 1, 1, 1, 0, 1, 0, 0, 0),

                (0, 0, 0, 1, 0, 0, 1, 0, 0, 0),

                (1, 1, 0, 1, 0, 0, 1, 1, 1, 0),

                (0, 1, 0, 0, 0, 0, 1, 0, 0, 0),

                (0, 1, 0, 0, 0, 0, 1, 0, 0, 0)

         );

var

   XS, YS, XE, YE : Byte;

   X, Y, I : Byte;

   MapM : array [1..10, 1..10] of Byte;

   Moves : Byte;

   MovesX : array [1..100] of Byte;

   MovesY : array [1..100] of Byte;

Procedure Next(Var X, Y : Byte);

Begin

     If (X <10) and (MapM[X, Y] - MapM[X + 1, Y] = 1) then

        Begin

             X := X + 1;

             Exit;

        End;

     If (X >1) and (MapM[X, Y] - MapM[X - 1, Y] = 1) then

        Begin

             X := X - 1;

             Exit;

        End;

     If (Y <10) and (MapM[X, Y] - MapM[X, Y + 1] = 1) then

        Begin

             Y := Y + 1;

             Exit;

        End;

     If (Y >1) and (MapM[X, Y] - MapM[X, Y - 1] = 1) then

        Begin

             Y := Y - 1;

             Exit;

        End;

End;

Begin

     ClrScr;

     For Y := 1 to 10 do

         Begin

              For X := 1 to 10 do Write(Map[X, Y], ' ');

              WriteLn;

         End;

     WriteLn('Please enter X and Y of the start: ');

     ReadLn(XS, YS);

     WriteLn('Please enter X and Y of the end: ');

     ReadLn(XE, YE);

     If (Map[XS, YS] = 1) or (Map[XE, YE] = 1) then

        Begin

             WriteLn('Error!!!');

             ReadLn;

             Halt;

        End;

     MapM[XS, YS] := 1;

     I := 1;

     Repeat

           I := I + 1;

           For Y := 1 to 10 do

             For X := 1 to 10 do

               If MapM[X, Y] = I - 1 then

                 Begin

                   If (Y <10) and (MapM[X, Y + 1] = 0)
and (Map[X, Y+1] = 0) Then MapM[X, Y+1] := I;

                   If (Y >1)
and (MapM[X, Y-1] = 0) and (Map[X, Y-1] = 0) Then MapM[X, Y-1] := I;

                   If (X <10)
and (MapM[X+1, Y] = 0) and (Map[X+1, Y] = 0) Then MapM[X+1, Y] := I;

                   If (X >1)
and (MapM[X-1, Y] = 0) and (Map[X-1, Y] = 0) Then MapM[X-1, Y] := I;

                  End;

         If I = 100 then

              Begin

                   WriteLn('You can''t go there!!!');

                   ReadLn;

                   Halt;

              End;

     Until MapM[XE, YE] >0;

     Moves := I - 1;

     X := XE;

     Y := YE;

     I := Moves;

     Map[XE, YE] := 4;

     Repeat

           MovesX := X;

           MovesY := Y;

           Next(X, Y);

           Map[X, Y] := 3;

           I := I - 1;

     Until (X = XS) and (Y = YS);

     Map[XS, YS] := 2;

     For I := 1 to Moves do WriteLn('X = ', MovesX,', Y = ', MovesY);

     WriteLn('Total: ', Moves, ' moves');

     ReadLn;

     For Y := 1 to 10 do

         Begin

              For X := 1 to 10 do Write(Map[X, Y], ' ');

              WriteLn;

         End;

     ReadLn;

End.