//Program zostal pobrany ze strony www.algorytm.org
//Znajdziesz tam dużo iekawych algorytmów oraz struktór danych wraz
//z dokladnym opisem i przykladowymi programami
//Program opracowal Michal Knasiecki
//*************************************************************************
//UWAGA!
//Format pliku z labiryntem: tablica rozmiaru 10*10,
//Spacja oznacza wolne przejscie a znak "x" cegielke. Zobacz przykladowe pliki
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    PaintBox1: TPaintBox;
    Bevel1: TBevel;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  Type //Typ wykorzystywany w obsludze kolejki
       wskaznik_kolejki=^skladnik_kolejki;
       skladnik_kolejki=record
                        odl:integer;
                        xpos:integer;
                        ypos:integer;
                        wskaznik:wskaznik_kolejki;
                        end;


var
  Form1: TForm1;
  labirynt:array[1..10,1..10]of integer;
  wejscie,wyjscie:record
                x,y:integer;
                end;
  koniec_kolejki,poczatek_kolejki:wskaznik_kolejki;
                
     //Deklaracja procedur obslugi kolejki zawartych w bibliotece DLL
     //Nieskompilowana wersja procedur znajduje się w pliku Queue.DPR
        procedure DodajPunkt(var odl_,xpos_,ypos_:integer;
        var koniec_kolejki:wskaznik_kolejki);external 'Queue.Dll';
        procedure UsunPunkt(var odl_,xpos_,ypos_:integer;
        var poczatek_kolejki:wskaznik_kolejki);external 'Queue.Dll';

implementation

{$R *.DFM}
procedure rysuj_labirynt;//Na podstawie tablicy procedura ta rysuje labirynt
var i,j:byte;
begin
for i:=1 to 10 do
        for j:=1 to 10 do
        begin
        //ustalanie koloru cegielek
        if labirynt[i,j]=-1 then form1.paintbox1.canvas.brush.color:=clnavy else
        form1.paintbox1.canvas.brush.color:=clwhite;
        //rysowanie cegielek
        form1.PaintBox1.Canvas.Rectangle(i*10-10,j*10-10,i*10,j*10);
        end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var f:textfile;
c:char;
i,j:byte;
begin
if opendialog1.execute then
//Wczytaj labirynt
begin
assignfile(f,opendialog1.filename);
reset(f);
for i:=1 to 10 do
begin
for j:=1 to 10 do
        begin
        read(f,c);
        if c='x' then labirynt[j,i]:=-1 else labirynt[j,i]:=0;
        end;
readln(f);
end;
closefile(f);
rysuj_labirynt;
button2.enabled:=true;//Odblokowanie przycisku "Znajdź"
end;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
rysuj_labirynt;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
form1.PaintBox1.Canvas.Pen.color:=clwhite;
end;
procedure Znajdz_We_Wy;//Procedura znajduje wejscie i wyjscie z labiryntu na jego brzegach
var i:byte;
begin
wejscie.x:=0;
wejscie.y:=0;
wyjscie.x:=0;
wyjscie.y:=0;
//Sprawdzanie pierwszego rzędu
for i:=1 to 10 do
if labirynt[i,1]=0 then
begin
if wejscie.x=0 then
begin
wejscie.x:=i;
wejscie.y:=1;
end else
begin
wyjscie.x:=i;
wyjscie.y:=1;
end;
end;
//Sprawdzanie ostatniego rzędu
for i:=1 to 10 do
if labirynt[i,10]=0 then
begin
if wejscie.x=0 then
begin
wejscie.x:=i;
wejscie.y:=10;
end else
begin
wyjscie.x:=i;
wyjscie.y:=10;
end;
end;
//Sprawdzanie pierwszej kolumny
for i:=1 to 10 do
if labirynt[1,i]=0 then
begin
if wejscie.x=0 then
begin
wejscie.x:=1;
wejscie.y:=i;
end else
begin
wyjscie.x:=1;
wyjscie.y:=i;
end;
end;
//Sprawdzanie ostatniej kolumny
for i:=1 to 10 do
if labirynt[10,i]=0 then
begin
if wejscie.x=0 then
begin
wejscie.x:=10;
wejscie.y:=i;
end else
begin
wyjscie.x:=10;
wyjscie.y:=i;
end;
end;
//Uwaga: Zakladam, że w naszym labiryncie jest dokladnie 1 wescie i 1 wyjscie!!!
//Radzę dopisac jeszcze fragment kodu, który sprawdza, czy w labiryncie
//nie ma więcej wejsc i wyjsc.
end;
procedure Gdzie_Isc(x,y:byte;out up,dn,left,right:boolean);
//Procedura ta sprawdza, w jakich kierunkach można isc z punktu (x,y)
begin
up:=false;
dn:=false;
left:=false;
right:=false;
if labirynt[x+1,y]=0 then right:=true;
if labirynt[x-1,y]=0 then left:=true;
if labirynt[x,y+1]=0 then dn:=true;
if labirynt[x,y-1]=0 then up:=true;
end;
procedure Rysuj_Droge(var l:integer);
var x,y:integer;
i:integer;
begin
x:=Wyjscie.x;
y:=Wyjscie.y;
form1.paintbox1.canvas.brush.color:=clgreen;
for i:=l+1 downto 1 do
        begin
        if labirynt[x-1,y]=i-1 then dec(x);
        if labirynt[x+1,y]=i-1 then inc(x);
        if labirynt[x,y-1]=i-1 then dec(y);
        if labirynt[x,y+1]=i-1 then inc(y);
        form1.paintbox1.canvas.ellipse(x*10-10,y*10-10,x*10,y*10);
        end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var up,dn,lt,rt,koniec:boolean;
licznik:integer;
x_pos,y_pos,x,y:integer;
begin
Znajdz_We_Wy; //Ustalanie wspólrzędnych wejscia i wyjscia.
licznik:=1;
koniec_kolejki:=nil;
poczatek_kolejki:=nil;
dodajpunkt(licznik,wejscie.x,wejscie.y,koniec_kolejki);
poczatek_kolejki:=koniec_kolejki;
koniec:=false;
repeat
usunpunkt(licznik,x_pos,y_pos,poczatek_kolejki);
Gdzie_Isc(x_pos,y_pos,up,dn,lt,rt);
if dn=true then
                begin
                y:=y_pos+1;
                x:=x_pos;
                inc(licznik);
                labirynt[x,y]:=licznik;
                dodajpunkt(licznik,x,y,koniec_kolejki);
                if poczatek_kolejki=nil then poczatek_kolejki:=koniec_kolejki;
                end;
if up=true then
                begin
                y:=y_pos-1;
                x:=x_pos;
                inc(licznik);
                labirynt[x,y]:=licznik;
                dodajpunkt(licznik,x,y,koniec_kolejki);
                if poczatek_kolejki=nil then poczatek_kolejki:=koniec_kolejki;
                end;
if lt=true then
                begin
                y:=y_pos;
                x:=x_pos-1;
                inc(licznik);
                labirynt[x,y]:=licznik;
                dodajpunkt(licznik,x,y,koniec_kolejki);
                if poczatek_kolejki=nil then poczatek_kolejki:=koniec_kolejki;
                end;
if rt=true then
                begin
                y:=y_pos;
                x:=x_pos+1;
                inc(licznik);
                labirynt[x,y]:=licznik;
                dodajpunkt(licznik,x,y,koniec_kolejki);
                if poczatek_kolejki=nil then poczatek_kolejki:=koniec_kolejki;
                end;
if (x=Wyjscie.x)and(y=Wyjscie.y)then koniec:=true;
until (koniec);
rysuj_droge(licznik);
end;

end.

library Queue;

uses
  SysUtils,
  Classes;
Type
       wskaznik_kolejki=^skladnik_kolejki;
       skladnik_kolejki=record
                        odl:integer;
                        xpos:integer;
                        ypos:integer;
                        wskaznik:wskaznik_kolejki;
                        end;

{$R *.RES}
procedure DodajPunkt(var odl_,xpos_,ypos_:integer;var koniec_kolejki:wskaznik_kolejki);
var punkt:wskaznik_kolejki;
begin
punkt:=koniec_kolejki;
new(koniec_kolejki);
with koniec_kolejki^ do
        begin
        odl:=odl_;
        xpos:=xpos_;
        ypos:=ypos_;
        wskaznik:=nil
        end;
if punkt<>nil then punkt^.wskaznik:=koniec_kolejki;
end;
Procedure UsunPunkt(var odl_,xpos_,ypos_:integer;var poczatek_kolejki:wskaznik_kolejki);
var punkt:wskaznik_kolejki;
begin
if poczatek_kolejki<>nil then
begin
with poczatek_kolejki^ do
begin
odl_:=odl;
xpos_:=xpos;
ypos_:=ypos;
punkt:=wskaznik;
end;
dispose(poczatek_kolejki);
poczatek_kolejki:=punkt;
end;
end;
exports
dodajpunkt,
usunpunkt;
begin
end.