backtracking.pas

program Pelda26;
uses crt;

var lab:array [1..10,1..10] of byte
         = ((9,9,9,9,9,9,9,9,9,9),
            (9,0,0,9,0,9,0,9,0,5),
            (9,0,9,9,0,9,0,9,0,9),
            (9,0,0,0,0,9,0,0,0,9),
            (9,9,0,9,9,9,9,9,0,9),
            (9,0,0,0,0,0,0,9,0,9),
            (9,0,9,9,9,0,9,0,0,9),
            (9,0,0,0,9,0,0,0,9,9),
            (9,0,9,0,9,0,9,0,0,9),
            (9,0,9,9,9,9,9,9,9,9));

procedure kiiras;
var i,j:integer;
begin
 for i:=1 to 10 do
  begin
   for j:=1 to 10 do
    case lab[i,j] of
     9: begin {fal}
        textcolor(lightgray);
        write(#219); { #219 = befestett
                      negyzet karakter }
        end;
   0,5: write(' '); { ures vagy celpont }
     1: begin { helyes utvonal }
        textcolor(lightgreen);
        write('X');
        end;
     2: begin { bejart, de rossz utvonal }
        textcolor(red);
        write('O');
        end;
    end;
   writeln;
  end;
 writeln;
end;

procedure lepes(x,y:integer);
begin
 { nem ertunk be a celba? }
 if lab[x,y]<>5 then
  begin
   { lepes elore... }
   lab[x,y]:=1;
   { van felfele bejaratlan utvonal (ures vagy celpont)? }
   if (x>1) and (lab[x-1,y] in [0,5]) then lepes(x-1,y);
   { van jobbra bejaratlan utvonal (ures vagy celpont)? }
   if (y<10) and (lab[x,y+1] in [0,5]) then lepes(x,y+1);
   { van balra bejaratlan utvonal (ures vagy celpont)? }
   if (y>1) and (lab[x,y-1] in [0,5]) then lepes(x,y-1);
   { van lefele bejaratlan utvonal (ures vagy celpont)? }
   if (x<10) and (lab[x+1,y] in [0,5]) then lepes(x+1,y);
   { lepes vissza...
   megjeloles bejart, de rossz utvonalnak }
   lab[x,y]:=2;
  end
 else
  begin
   { celba ertunk, utolso lepes elore... }
   lab[x,y]:=1;
   { megtalalt utvonal kirajzolasa }
   kiiras;
   { utolso lepes vissza }
   lab[x,y]:=2;
  end;
end;

begin
 clrscr;
 { ures labirintus kirajzolasa }
 kiiras;
 { megoldas keresese,
 elso lepes: [10,2] }
 lepes(10,2);
 { magyarazat kiirasa }
 textcolor(lightgray);
 writeln(#219,' ... fal');
 textcolor(red);
 write('O');
 textcolor(lightgray);
 writeln(' ... bejart, de rossz utvonal');
 textcolor(lightgreen);
 write('X');
 textcolor(lightgray);
 write(' ... helyes utvonal');
 { varakozas egy billentyu megnyomasara }
 readkey;
end.