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 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));
for i:= 0 to getarraylength(myAOTPA)-1 do
begin
answers[i]:=mdptofarray(tmpslope,myAOTPA[i]);
end;
writeln(tPtArrayToStr(answers));
end.