All pastes #452561 Raw Edit

Anonymous

public text v1 · immutable
·published 2007-04-22 11:13 UTC
rendered paste body
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 myAOTPA:array of array of tpoint;
answers:array of tpoint;
tmpslope:extended;
tx,ty:integer;
var mytpa:array of tpoint;
i:integer;
begin

getsymbolcolor(tx,ty,SymbolName);
FindColorsSpiralTolerance(tx,ty,mytpa,getcolor(tx,ty),mmx1,mmy1,mmx2,mmy2,0);
  myAOTPA:=SplitTPA10(myTPA);
 setarraylength(answers,getarraylength(myaotpa));


for i:= 0 to getarraylength(myAOTPA)-1 do
begin
answers[i]:=mdptofarray(tmpslope,myAOTPA[i]);
end;
AnsTPA:=answers;
//writeln(tPtArrayToStr(answers));
end;

var mytpa:array of tpoint;
begin
setupsrl;
findsymbols(mytpa,'water');
writeln(tPtArrayToStr(mytpa));
end.