program New;
{.include srl/srl.scar}
var mytpa:array of tpoint;
i:integer;
function RearrangeTPA(thearray:array of tpoint; startpt, endpt:integer; dox,up:boolean):array of tpoint;
var
temp, pArray : integer;
done : boolean;
ttp:tpoint;
tmpTPA : array of tpoint;
begin
setarraylength(tmpTPA,getarraylength(thearray));
tmpTPA:=thearray;
setarraylength(result,endpt+1-startpt);
if not(up) then
begin
if dox then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].x < tmpTPA[pArray + 1].x) then
begin
//temp := tmpTPA[pArray].x;
//tmpTPA[pArray].x := tmpTPA[pArray + 1].x;
//tmpTPA[pArray + 1].x := temp;
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
if not(dox) then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].y < tmpTPA[pArray + 1].y) then
begin
//temp := thearray[pArray].y;
//tmpTPA[pArray].y := tmpTPA[pArray + 1].y;
//tmpTPA[pArray + 1].y := temp;
ttp := thearray[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
end;
if up then
begin
if dox then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].x > tmpTPA[pArray + 1].x) then
begin
//temp := tmpTPA[pArray].x;
//tmpTPA[pArray].x := tmpTPA[pArray + 1].x;
//tmpTPA[pArray + 1].x := temp;
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
if not(dox) then
begin
repeat
done := true;
for pArray := 0 to (getarraylength(thearray) - 2) do
begin
if(tmpTPA[pArray].y > tmpTPA[pArray + 1].y) then
begin
//temp := tmpTPA[pArray].y;
// tmpTPA[pArray].y := tmpTPA[pArray + 1].y;
//tmpTPA[pArray + 1].y := temp;
ttp := tmpTPA[pArray];
tmpTPA[pArray] := tmpTPA[pArray + 1];
tmpTPA[pArray + 1] := ttp;
done := false;
end;
end;
until(done);
end;
end;
pArray:=startpt-1;
for temp:=0 to getarraylength(result)-1 do
begin
pArray:=pArray+1;
result[temp]:=tmpTPA[pArray];
end;
end;
function tPtArrayToStr(newTPoint: TPointArray): string;
var
i: Integer;
begin
for i:=0 to GetArrayLength(newTPoint)-1 do
begin
Result := Result + IntToStr(newTPoint[i].x) + ',' +
IntToStr(newTPoint[i].y);
if (not (i = (GetArrayLength(newTPoint) - 1))) then
Result := Result + ' ';
end;
end;
function Nearby(FirstTP,SecondTP:tpoint):boolean;
begin
if ((FirstTP.x+1=SecondTP.x)or (FirstTP.x=SecondTP.x)or(FirstTP.x-1=SecondTP.x)) and ((FirstTP.y+1=SecondTP.y)or (FirstTP.y=SecondTP.y)or(FirstTP.y-1=SecondTP.y)) then
result:=true;
end;
function SplitTPA(OldArray: array of Tpoint):Array of Array of Tpoint;
var
pFirst,pSecond,pThird:integer;
OldLength:integer;
NewLength,tmpLength:integer;
begin
OldLength:=getarraylength(OldArray);
for pFirst:=0 to OldLength-1 do
begin
if not((OldArray[pFirst].x=0){and(OldArray[pFirst].y=0)}) then
begin
tmpLength:=0;
NewLength:=NewLength+1;
setarraylength(result,NewLength);
tmpLength:=tmpLength+1
setarraylength(result[NewLength-1],tmpLength);
result[NewLength-1][0]:=OldArray[pFirst];
OldArray[pFirst].x:=0;
pSecond:=-1;
repeat
pSecond:=pSecond+1;
for pThird:=0 to OldLength-1 do
begin
if not((OldArray[pThird].x=0){and(OldArray[pFirst].y=0)}) then
begin
if Nearby(OldArray[pThird],result[NewLength-1][pSecond])then
begin
tmpLength:=tmpLength+1
setarraylength(result[NewLength-1],tmpLength);
result[NewLength-1][tmpLength-1]:=OldArray[pThird];
OldArray[pThird].x:=0;
//OldArray[pThird].y:=0;
end;
end;
end;
until pSecond=tmplength-1;
end;
end;
end;
function MdPtOfArray(var Slope: extended; TheArray: array of tpoint): tpoint;
var
ArrayLength,minx,miny,maxx,maxy:integer;
tmpTPA: array of tpoint;
begin
ArrayLength:=getarraylength(TheArray);
setarraylength(tmpTPA,ArrayLength);
tmpTPA:=TheArray;
if not(ArrayLength=1) then
tmpTPA:=RearrangeTPA(TheArray,0,ArrayLength-1,true,true);
minx:=tmpTPA[0].x;
maxx:=tmpTPA[ArrayLength-1].x;
tmpTPA:=TheArray;
if not(ArrayLength=1) then
tmpTPA:=RearrangeTPA(TheArray,0,ArrayLength-1,false,true);
miny:=tmpTPA[0].y;
maxy:=tmpTPA[ArrayLength-1].y;
if ArrayLength=1 then
begin
result:=TheArray[0];
Slope:=1;
exit;
end;
result.x:=round((maxx+minx)/2)
result.y:=round((maxy+miny)/2)
if (maxx-minx)=0 then
begin
slope:=150.0;
exit;
end;
if (maxy-miny)=0 then
begin
slope:=0.0;
exit;
end;
Slope:=((maxy-miny)/(maxx-minx));
end;
Var DebugCanvas,BmpCanvas,BlankMapCanvas:TCanvas;
procedure AddArray (WhichTPA:array of tpoint; WhichColor:integer);
var parray, arraylength:integer;
begin
arraylength:=getarraylength(whichtpa);
for parray:=0 to arraylength-1 do
bmpcanvas.pixels[whichtpa[parray].x-576+5,whichtpa[parray].y-9+5]:=WhichColor;
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,155,162)
end;
procedure StartMiniMapDebug;
Var bmpBlankMap:integer;
begin {
bmpBlankMap:= LoadBitmap(apppath+'test.bmp');
DisplayDebugImgWindow(160,167) //to show the canvas
DebugCanvas:=getdebugcanvas //gets the referance to the debug image and stores in that varaible
BmpCanvas:=GetBitmapCanvas(bmpBlankMap)//gets the regerance to the bmp and stores in that variable
BlankMapCanvas:=GetBitmapCanvas(bmpBlankMap);
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,155,162)
FreeBitmap(bmpBlankMap);
}
bmpBlankMap:= LoadBitmap(apppath+'test.bmp');
DisplayDebugImgWindow(160,167) //to show the canvas
DebugCanvas:=getdebugcanvas //gets the referance to the debug image and stores in that varaible
BmpCanvas:=GetBitmapCanvas(bmpBlankMap)//gets the regerance to the bmp and stores in that variable
Copycanvas(BmpCanvas,DebugCanvas,0,0,150,157,5,5,155,162)
end;
var myAOTPA:array of array of tpoint;
answers:array of tpoint;
tmpslope:extended;
begin
setupsrl;
getsymbolcolor(x,y,'water');
//writeln(inttostr(x)+' '+inttostr(y)+' '+inttostr(getcolor(x,y)));
FindColorsSpiralTolerance(x,y,mytpa,getcolor(x,y),mmx1,mmy1,mmx2,mmy2,0);
myAOTPA:=SplitTPA(myTPA);
setarraylength(answers,getarraylength(myaotpa));
StartMiniMapDebug
for i:= 0 to getarraylength(myAOTPA)-1 do
begin
writeln('press f12');
repeat
wait(30);
until isfkeydown(12);
//StartMiniMapDebug;
//writeln(tPtArrayToStr(myAOTPA[f]));
writeln('press f11');
repeat
wait(30);
until isfkeydown(11);
AddArray(myAOTPA[i],16777215);
answers[i]:=mdptofarray(tmpslope,myAOTPA[i]);
end;
writeln(tPtArrayToStr(answers));
end.