program New; {.include srl/srl.scar} 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 Nearby10(FirstTP,SecondTP:tpoint):boolean; begin if (abs(FirstTP.x-SecondTP.x)<=10) and (abs(FirstTP.y-SecondTP.y)<=10) then result:=true; end; function SplitTPA10(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 Nearby10(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; procedure FindSymbols(var AnsTPA:array of tpoint;SymbolName:string); var tmpAOTPA:array of array of tpoint; tmpslope:extended; pAOTPA,tmpAL,tx,ty:integer; begin getsymbolcolor(tx,ty,SymbolName); FindColorsSpiralTolerance(tx,ty,AnsTPA,getcolor(tx,ty),mmx1,mmy1,mmx2,mmy2,0); tmpAOTPA:=SplitTPA10(AnsTPA); tmpAL:=getarraylength(tmpAOTPA); setarraylength(AnsTPA,tmpAL); for pAOTPA:= 0 to tmpAL-1 do AnsTPA[pAOTPA]:=mdptofarray(tmpslope,tmpAOTPA[pAOTPA]); end; var mytpa:array of tpoint; begin setupsrl; findsymbols(mytpa,'water'); writeln(tPtArrayToStr(mytpa)); end.