Simba Code:
type
node = record
color : integer;
fscore : integer;
gscore : integer;
hscore : integer;
isopen : boolean;
isclosed : boolean;
x : integer;
y : integer;
parent : TPoint;
end;
nodelist = array of array of node;
var
map,mapx,mapy,x,y{,startx,starty,endx,endy},counter,starttime,savetime,endtime,pathx,pathy,ctime,itime,tcount,fcount,ftime,tftime,isopentime,isopentotal,isopencount : Integer;
openedlist1,fscore,gscore,hscore : array of array of integer;
closed,tocheck,path,finalpath : TPointArray;
open : array of node;
parent : array of array of TPoint;
lowestf : TPoint;
tiles : nodelist
procedure printnode(i : node);
begin
write('color: ' +inttostr(i.color) + ', fscore: '+inttostr(i.fscore)+', gscore: '+inttostr(i.fscore)+', hscore: '+inttostr(i.hscore)+', closed: ');
write(i.isclosed);
write(', open ');
write(i.isopen);
writeln(', x: ' +inttostr(i.x)+ ', y: '+inttostr(i.y));
end;
function isOpen(x,y:integer) : boolean;
begin
result := tiles[x][y].isopen;
end
function isClosed(x,y:integer) : boolean;
begin
result := tiles[x][y].isclosed;
end
function getParentTile(x,y:integer) : TPoint;
begin
result := tiles[x][y].parent;
end
procedure addOpenList(j : node);
var
i : Integer;
begin
//printnode(j);
i := length(open);
setlength(open,i+1);
open[i] := j;
end
function match(i,j:node) : boolean;
begin
result := (i.color = j.color) and (i.fscore = j.fscore) and (i.gscore = j.gscore)
and (i.hscore = j.hscore) and (i.isopen = j.isopen) and (i.isclosed = j.isclosed)
and (i.parent.x = j.parent.x) and (i.parent.y = j.parent.y) and (i.x = j.x)
and (i.y = j.y);
end
procedure removeOpenList(t : node);
var
i,j : integer;
begin
for i := 0 to length(open) - 1 do
begin
if (match(open[i], t)) then
begin
for j := i to length(open) - 1 do
open[j] := open[j+1];
setlength(open,length(open) - 1);
exit;
end;
end;
end
procedure addOpen(x,y:integer);
begin
fastsetpixel(map,x,y,13217535);
tiles[x][y].isopen := true;
addOpenList(tiles[x][y]);
end
procedure addClosed(x,y:integer);
var
i : Integer;
begin
fastsetpixel(map,x,y,62207);
tiles[x][y].isclosed := true;
end
procedure removeOpen(x,y:integer);
begin
removeOpenList(tiles[x][y]);
tiles[x][y].isopen := false;
end
procedure removeClosed(x,y:integer);
begin
tiles[x][y].isclosed := true;
end
{procedure printOpen();
var
i:integer;
begin
for i := 0 to length(open) do
writeln(open[i]);
end
procedure printClosed();
var
i:integer;
begin
for i := 0 to length(Closed)-1 do
writeln(Closed[i]);
end}
function Manhattan(x,y,x2,y2:Integer): Integer;
begin
result := (Abs(x-x2) + Abs(y-y2))*10;
end;
procedure opensurrounding(x,y,endx,endy:integer);
var
i : TPoint;
j,g,myg : integer;
begin
myg := gscore[x][y];
{writeln('mygstart' + inttostr(myg));
setlength(tocheck,8);
tocheck[0] := Point(x-1,y+1);
tocheck[1] := Point(x,y+1);
tocheck[2] := Point(x+1,y+1);
tocheck[3] := Point(x-1,y);
tocheck[4] := Point(x+1,y);
tocheck[5] := Point(x-1,y-1);
tocheck[6] := Point(x,y-1);
tocheck[7] := Point(x+1,y-1);
for j := 0 to length(tocheck) - 1 do
begin
if(j = 0) or (j = 2) or (j = 5) or (j = 7) then
g := 14
else
g := 10; }
setlength(tocheck,4);
tocheck[0] := Point(x,y+1);
tocheck[1] := Point(x-1,y);
tocheck[2] := Point(x+1,y);
tocheck[3] := Point(x,y-1);
g := 10;
for j := 0 to length(tocheck) - 1 do
begin
if (tiles[tocheck[j].x][tocheck[j].y].color <> 0) then
begin
//writeln(isOpen(tocheck[j].x,tocheck[j].y));
//writeln(isOpen(tocheck[j].x,tocheck[j].y));
tiles[tocheck[j].x][tocheck[j].y].parent := Point(x,y);
tiles[tocheck[j].x][tocheck[j].y].hscore := Manhattan(tocheck[j].x,tocheck[j].y,endx,endy);
tiles[tocheck[j].x][tocheck[j].y].gscore := g + myg;
tiles[tocheck[j].x][tocheck[j].y].fscore := (hscore[tocheck[j].x][tocheck[j].y] + g + myg);
tiles[tocheck[j].x][tocheck[j].y].x := tocheck[j].x;
tiles[tocheck[j].x][tocheck[j].y].y := tocheck[j].y;
if not (isOpen(tocheck[j].x,tocheck[j].y)) then
addopen(tocheck[j].x,tocheck[j].y);
end;
end;
end;
procedure opensurroundingignoreclosed(x,y,endx,endy:integer);
var
i : TPoint;
j,g,myg : integer;
begin
myg := tiles[x][y].gscore;
//writeln('mygclosed: ' + inttostr(myg));
{setlength(tocheck,8);
tocheck[0] := Point(x-1,y+1);
tocheck[1] := Point(x,y+1);
tocheck[2] := Point(x+1,y+1);
tocheck[3] := Point(x-1,y);
tocheck[4] := Point(x+1,y);
tocheck[5] := Point(x-1,y-1);
tocheck[6] := Point(x,y-1);
tocheck[7] := Point(x+1,y-1);
for j := 0 to length(tocheck) - 1 do
begin
if(j = 0) or (j = 2) or (j = 5) or (j = 7) then
g := 14
else
g := 10;}
setlength(tocheck,4);
tocheck[0] := Point(x,y+1);
tocheck[1] := Point(x-1,y);
tocheck[2] := Point(x+1,y);
tocheck[3] := Point(x,y-1);
g := 10;
for j := 0 to length(tocheck) - 1 do
begin
if (tocheck[j].x >= 0) and (tocheck[j].x < mapx) and (tocheck[j].y >= 0) and (tocheck[j].y <= mapy) then
begin
if (tiles[tocheck[j].x][tocheck[j].y].color <> 0) then
begin
if not (isOpen(tocheck[j].x,tocheck[j].y)) and not (isClosed(tocheck[j].x,tocheck[j].y)) then
begin
tiles[tocheck[j].x][tocheck[j].y].parent := Point(x,y);
tiles[tocheck[j].x][tocheck[j].y].hscore := Manhattan(tocheck[j].x,tocheck[j].y,endx,endy);
tiles[tocheck[j].x][tocheck[j].y].gscore := (g + myg);
tiles[tocheck[j].x][tocheck[j].y].fscore := (tiles[tocheck[j].x][tocheck[j].y].hscore + (g + myg));
tiles[tocheck[j].x][tocheck[j].y].x := tocheck[j].x;
tiles[tocheck[j].x][tocheck[j].y].y := tocheck[j].y;
addopen(tocheck[j].x,tocheck[j].y);
end;
end;
end;
end;
end;
function getLowestFScoreOpen():TPoint;
var
low,lx,ly,x,y,i:integer;
tilething : TPoint;
//n : node;
begin
low:=10000000;
{//writeln(open[length(open)]);
for i := (length(open) - 1) downto 0 do
begin
if(fscore[open[i].x][open[i].y] < low) and (fscore[open[i].x][open[i].y] >= 1) then
begin
lx := open[i].x;
ly := open[i].y;
low := fscore[open[i].x][open[i].y];
end;
end;
}
{
for x := 0 to length(tiles) - 1 do
begin
for y := 0 to length(tiles[0]) -1 do
begin
if(tiles[x][y].isOpen) then
begin
if(tiles[x][y].fscore < low) then
begin
//writeln('found new low');
lx := x;
ly := y;
low := tiles[x][y].fscore;
end;
end;
end;
end;
}
for i := length(open) -1 downto 0 do
begin
if(open[i].fscore < low) then
begin
lx := open[i].x;
ly := open[i].y;
low := open[i].fscore;
end;
end;
if (low < 10000000) then
begin
result := Point(lx,ly);
exit;
end;
result := Point(-1,-1);
end
function getPath(startx,starty,endx,endy:integer) : TPointArray;
var
retpath : TPointarray;
begin
setlength(path,0);
setlength(open,0);
setlength(closed,0);
map := LoadBitmap('C:/Simba/map.bmp');
getBitmapSize(map,mapx,mapy);
setlength(openedlist1,mapx,mapy);
setlength(tiles,mapx,mapy);
setlength(fscore,mapx,mapy);
setlength(gscore,mapx,mapy);
setlength(hscore,mapx,mapy);
setlength(parent,mapx,mapy);
dec(mapx);
dec(mapy);
for y:= 0 to mapy do
begin
for x := 0 to mapx do
begin
tiles[x][y].color := FastGetPixel(map,x,y);
tiles[x][y].fscore := -1;
tiles[x][y].hscore := -1;
tiles[x][y].gscore := -1;
tiles[x][y].isopen := false;
tiles[x][y].isclosed := false;
tiles[x][y].x = x;
tiles[x][y].y = y;
tiles[x][y].parent := point(-1,-1);
end;
end;
starttime := GetSystemTime();
savetime := starttime;
tiles[startx][starty].parent := Point(startx,starty);
tiles[startx][starty].hscore := Manhattan(startx,starty,endx,endy);
tiles[startx][starty].gscore := 10;
tiles[startx][starty].fscore := hscore[startx][starty] + 10;
tiles[startx][starty].x := startx;
tiles[startx][starty].y := starty;
AddOpen(startx,starty);
opensurrounding(startx,starty,endx,endy);
RemoveOpen(startx,starty);
AddClosed(startx,starty);
for counter := 0 to (mapx*mapy) do
begin
if(isOpen(endx,endy)) or (isClosed(endx,endy)) then
begin
writeln('found end in ' +inttostr(GetSystemTime() - starttime) + ' MS');
break;
end;
if((getSystemTime() - savetime) > 10000) then
begin
savebitmap(map,'C:\Simba\pathedmap.bmp');
writeln('bitmap saved');
savetime := getSystemTime();
end;
ftime := getSystemTime();
lowestf := getLowestFScoreopen();
//writeln(lowestf);
tftime := ((getSystemTime() - ftime) + tftime);
inc(fcount,1);
if (lowestf.x >=0) then
begin
ctime := getSystemTime();
x:=lowestf.X;
y:=lowestf.Y;
removeOpen(x,y);
AddClosed(x,y);
opensurroundingignoreclosed(x,y,endx,endy);
itime := ((getSystemTime() - ctime) + itime);
inc(tcount,1);
end;
end;
lowestf := getParentTile(endx,endy);
pathx := lowestf.X;
pathy := lowestf.Y;
//addPath(endx,endy);
while not ((pathx = startx) and (pathy = starty)) do
begin
if(pathx = -1) then
begin
writeln('bad path');
exit;
end;
lowestf := getParentTile(pathx,pathy);
pathx := lowestf.X;
pathy := lowestf.Y;
fastsetpixel(map,pathx,pathy,2366701);
//addPath(pathx,pathy);
end;
//writeln('ctime' + inttostr(getSystemTime() - ctime) +','+inttostr(tcount) +' totaltime: ' + inttostr(itime));
writeln(inttostr(tcount) + ' open totaltime: ' +inttostr(itime));
write('avg itime ');
writeln((itime/tcount));
writeln(inttostr(fcount) + ' lowfcount totaltime: ' +inttostr(tftime));
write('avg ftime ');
writeln((tftime/fcount));
//isopentime,isopentotal,isopencount
//writeln(inttostr(isopencount) + ' totalisopentime: ' +inttostr(isopentotal));
//write('avg isopentime ');
//writeln((isopentotal/isopencount));
writeln('saving map');
savebitmap(map,'C:\Simba\pathedmap.bmp');
InvertTPA(path);
result := path;
end;
begin
finalpath := getPath(3,3,634,476);
writeln('path length ' + inttostr(length(finalpath)));
//currently if you run this more than one time(per script run), the script will mess up
//due to painting on the map for debugging.
end.
The uploads are an example of the file to use as map.bmp(the first one), THESE ARE PNGS AS AN EXAMPLE. It would not let me upload the bitmaps.