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.