All pastes #632793 Raw Edit

Stuff

public text v1 · immutable
#632793 ·published 2007-07-25 05:00 UTC
rendered paste body
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.