program pathfinder;
uses
ptccrt, ptcgraph;
const
Maxrows = 15;
MaxColumns = 20;
PixelDepth = 32;
PixelWidth = 32;
StartX = 0;
startY = 0;
Target = 1;
Type
MapType = array[0..maxrows,0..maxcolumns] of byte;
// the x1,y1,x2,y2 and x,y are used for matrix positions, not pixel positions for this demo
LineT = record
x1,x2,y1,y2,
dx, dy, sx, sy, err,
x, y: integer;
j:integer;
end;
var
Mx,My,
SC,SR,
TC,TR,
rr,cc: Integer;
Map:MapType;
Path:LineT;
gmode,gdriver:smallint;
Procedure PaintBlock(M:MapType;r,c:integer);
var
x,y:integer;
begin
setfillstyle(solidfill,M[r,c]);
x := c*pixelwidth-startx;
y := r*pixeldepth-starty;
bar(x,y,x+pixelwidth,y+pixeldepth);
rectangle(x,y,x+pixelwidth,y+pixeldepth);
end;
{******************************************************************}
{ The "unrolling" of Brensenham's line algorithm starts with this }
Procedure SetPath(var LineInfo:LineT;SSY,SSX,EY,EX:integer);
begin
with LineInfo do
begin
x1 := SSX; Y1 := SSY;
X2 := EX; Y2 := EY;
X := X1; // starting point
Y := Y1;
dx := abs(x2 - x1);
dy := abs(y2 - y1);
if x1 < x2 then sx := 1 else sx := -1;
if y1 < y2 then sy := 1 else sy := -1;
err := dx - dy;
end;
end;
Procedure FindNextLocation(Var LineInfo:LineT);
begin
with LineInfo do
begin
if (x <> x2) or (y <> y2) then
begin
if (err > 0) then
begin
x := x + sx;
err := err - dy;
end
else
begin
y := y + sy;
err := err + dx;
end;
end;
end;
// x and y have the next location in the line
// which can be out of range in the matrix so it has to be adjusted if that happens
end;
{ *********** end of Bresenham's work ******************************}
// if true returns block right before target obstacle
Function PathFound(M:MapType;P:LineT;T:integer;var MatrixRow,MatrixColumn:integer):boolean;
var
found,ClearPath:boolean;
begin
FindNextLocation(p);
repeat
found := false;
FindNextLocation(p);
ClearPath := true;
if (P.x <0) or (P.X > MaxColumns) or
(P.Y <0) or (P.Y>maxcolumns) then
ClearPath := false; // out of matrix range has occurred
if ClearPath then
begin
if m[p.y,p.x] <> 0 then ClearPath := false; // obstacle found
if Not Clearpath and
(m[p.y,p.x] = T) then found := true; // if it's the target then good
end;
until found or not ClearPath;
MatrixColumn := -1; // if not a clear path then invalid row, invalid column returned
MatrixRow := -1;
if found then
begin
// if the target was found, back up the matrix position to before target
with path do
if err>0 then x := x -sx else y := y-sy;
MatrixColumn := p.x;
MatrixRow := p.y;
end;
result := found;
end;
begin
gdriver := vesa;
Gmode := installusermode(800, 600, 256, 1, 10000, 8000);
randomize;
WindowTitle := 'Path finder';
initgraph(gdriver, gmode, '');
fillchar(map,sizeof(map),0);
Tc := maxcolumns-2; Tr := 10; // target column, target row
Sr := 1; Sc := 1; // start row, start column
map[Sr,Sc] := 14;
map[Tr,Tc] := target;
// set up the "line of sight" to the target
SetPath(Path,Sr,Sc,TR,TC);
setcolor(7);
// put a wall around Target to test - remove comment slashes
// range checking not done here
//map[tr-1,tc-1] := 2;
//map[tr-2,tc] := 2;
//map[tr,tc-1] := 2;
// paint screen for demo
for rr := 0 to maxrows do
begin
for cc := 0 to maxcolumns do
begin
paintblock(map,rr,cc);
end;
end;
mx := 0; my := 0;
Setcolor(15);
if pathfound(map,path,Target,mx,my) then
begin
// my and mx have the location prior to target
outtextxy(300,getmaxy-80,'Found target');
// now draw path to target or positions can be stored for movement each animation cycle
FindNextLocation(Path);
repeat
map[path.y,path.x] := 14;
paintblock(map,path.y,path.x);
FindNextLocation(Path); // x and y updated for next position
until map[path.y,path.x] <> 0; // until target
end
else
begin
paintblock(Map,path.y1,path.x1);
outtextxy(300,getmaxy-80,'Target not found, obstacle or out of matrix range');
end;
readkey;
closegraph;
end.
Recent
