Someone

//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library SKyPlugin;

uses
  FastShareMem,
  SysUtils;

{$R *.res}

type
  TPoint = record
    x, y: Integer;
  end;
  TPointArray = array of TPoint;

  TRockObject = record
    Width, Height, x1, y1,
    x2, y2, mx, my, Color : Integer;
    P: TPointArray;
  end;
  TRockObjectArray = array of TRockObject;

//---------------------------------------
// Functions to be called from SCAR

function NearbyPointInArrayEx(const P: TPoint; w, h:Integer; a: TPointArray): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to High(a) do
    if (Abs(P.x - a[i].x) <= w) and (Abs(P.y - a[i].y) <= h) then
    begin
      Result := True;
      Exit;
    end;
end;

function NearbyPointInArray(const P: TPoint; Dist:Integer; a: TPointArray): Boolean;
begin
  Result := NearbyPointInArrayEx(P, Dist, Dist, a);
end;

function RockPoints(const Points: TPointArray; Dist: Integer): TRockObjectArray; stdcall;
var Color, Tol, PL, PPL, I, n, L: Integer;
    SetIt: Boolean;
begin
  Pl := Length(Points);
  if (Pl = 0) then exit;
    for I := 0 to PL do
    begin
     if (I < Pl-1) then
     begin
       PPL := Length(Result)-1;
       for n := 0 to PPL do
          if (NearbyPointInArray(Points[i], Dist, Result[n].P)) then
           begin
              L := length(Result[n].P);
              SetLength(Result[n].P, l + 1);
              Result[n].P[L] := Points[i];
              if (Result[n].x1 > Points[i].x) then Result[n].x1 := Points[i].x;
              if (Result[n].y1 > Points[i].y) then Result[n].y1 := Points[i].y;
              if (Result[n].x2 < Points[i].x) then Result[n].x2 := Points[i].x;
              if (Result[n].y2 < Points[i].y) then Result[n].y2 := Points[i].y;
              Break;
           end;

       if (PPL < n) then
         begin
            L := Length(Result);
            SetLength(Result, L + 1);
            SetLength(Result[L].P, 1);
            Result[L].P[0] := Points[i];
            Result[l].x1 := 516;
            Result[l].y1 := 338;
            SetIt := True;
         end;
       end;
        if (i > 1) and (SetIt) then
        begin
             L := Length(Result);
             Result[L-1].Width := Result[L-1].x2 - Result[L-1].x1;
             Result[L-1].Height := Result[L-1].y2 - Result[L-1].y1;
             Result[L-1].mx := Result[L-1].x1 + Result[L-1].Width shr 1;
             Result[L-1].my := Result[L-1].y1 + Result[L-1].Height shr 1;
             SetIt := False;
       end;
    end;
end;



//********************************
//  Change this accordingly to your function count

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 1;
end;

//*******************************
//  Change this accordingly to your function definitions

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
      begin
        ProcAddr := @RockPoints;
        StrPCopy(ProcDef, 'function RockPoints(Points: TPointArray; Dist: Integer): TRockObjectArray;');
      end;
  else
    x := -1;
  end;
  Result := x;
end;

//********************************
//  Change this accordingly to your type count

function GetTypeCount(): Integer; stdcall; export;
begin
  Result := 2;
end;

//*******************************
//  Types you want to add

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
  case x of
    0:
      begin
        sType := 'TRockObject';
        sTypeDef := 'record Width, Height, x1, y1, x2, y2, mx, my, Color: Integer; P: TPointArray; end;';
      end;
    1:
      begin
        sType := 'TRockObjectArray';
        sTypeDef := 'array of TRockObject';
      end;
  else
    x := -1;
  end;
  Result := x;
end;


//***************************
// Don't change below this
exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;

end.


function SplitTPAEx(const OldArray: TPointArray; w, h: Integer): TPointArrayArray; stdcall;
var
  pFirst, pSecond, pThird: Integer;
  OldLength: Integer;
  NewLength, tmpLength: Integer;
begin
  NewLength := 0;
  OldLength := Length(OldArray);
  SetLength(Result, 0);

  for pFirst := 0 to OldLength -1 do
  begin
    if OldArray[pFirst].x <> 0 then
    begin
      tmpLength := 0;
      NewLength := NewLength + 1;
      SetLength(Result, NewLength);
      tmpLength := tmpLength + 1;
      SetLength(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 OldArray[pThird].x <> 0 then
          begin
            if (Abs(OldArray[pThird].x - Result[NewLength - 1][pSecond].x) <= w) and (Abs(OldArray[pThird].y - Result[NewLength - 1][pSecond].y) <= h) then
            begin
              tmpLength := tmpLength + 1;
              SetLength(Result[NewLength - 1], tmpLength);
              Result[NewLength - 1][tmpLength - 1] := OldArray[pThird];
              OldArray[pThird].x := 0;
            end;
          end;
        end;
      until pSecond = tmplength - 1;
    end;
  end;
end;