SCAR Code:
//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library WizzyPlugin;
uses
FastShareMem,
SysUtils,
Classes,
Windows,
math,
Graphics,
Variants;
{$R *.res}
type
TPoint = record
x,y:integer;
end;
type TPointArray = array of TPoint;
Type
TPointArrayArray = Array of TPointArray;
//---------------------------------------
// Functions to be called from SCAR
//demonstration of procedure
function Distance(XPos, YPos, X, Y: Integer): Integer; stdcall;
begin
Result:=Round(sqrt(power(XPos-X,2)+power(YPos-Y,2)));
end;
Procedure tSwap(Var a, b: TPoint); stdcall;
Var
c: TPoint;
Begin
c := a;
a := b;
b := c;
End;
Procedure tpaSwap(Var a, b: TPointArray); stdcall;
Var
c: TPointArray;
Begin
c := a;
a := b;
b := c;
End;
procedure RAaSTPA(Var a: TPointArray; const Dist: Integer); stdcall;
Var
I, C, NoTP:Integer;
cCond: Boolean;
Begin
NoTP := 0;
For I := 0 To High(a) Do
Begin
cCond := False;
For C := 0 To NoTP - 1 Do
Begin
If (Abs(a[i].x - a[C].x) <= Dist) And (Abs(a[i].y - a[C].y) <= Dist) Then
Begin
cCond := True;
Break;
End;
End;
If Not cCond Then
Begin
tSwap(a[i], a[NoTP]);
NoTP := NoTP + 1;
End;
End;
SetLength(a, NoTP);
End;
Function NearbyPointInArray(P: TPoint; Dist:Integer; a: TPointArray): Boolean; stdcall;
Var
I: Integer;
Begin
Result := False;
For I := 0 To High(a) Do
If (Abs(P.x - a[i].x) <= Dist) And (Abs(P.y - a[i].y) <= Dist) Then
Begin
Result := True;
Exit;
End;
End;
Function ReArrangeAndShortenArray(a: TPointArray; Dist: Integer): TPointArray; stdcall;
Var
I: Integer;
Begin
For I := 0 To High(a) Do
If Not NearbyPointInArray(a[I], Dist, Result) Then
Begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1] := a[I];
End;
End;
Function TPAtoATPA(TPA: TPointArray; Dist: Integer): TPointArrayArray; stdcall;
Var
A, B: LongInt;
myFlag: Boolean;
Begin
SetLength(Result, 0);
For A := 0 To Length(tpa) - 1 Do
Begin
myFlag := True;
For B := 0 To Length(Result) - 1 Do
Begin
If Not MyFlag Then
Break;
If Distance(TPA[A].X, TPA[A].Y, Result[B][0].X, Result[B][0].Y) <= Dist Then
myFlag := False;
End;
If Not myFlag Then
Begin
SetLength(Result[B - 1], Length(Result[B - 1]) + 1);
Result[B - 1][Length(Result[B - 1]) - 1] := TPA[A];
End Else
Begin
SetLength(Result, Length(Result) + 1);
SetLength(Result[Length(Result) - 1], Length(Result[Length(Result) - 1]) + 1);
Result[Length(Result) - 1][Length(Result[Length(Result) - 1]) - 1] := TPA[A];
End;
End;
End;
Procedure SortTPAFrom(Var a: TPointArray; const From: TPoint); stdcall;
Var
I, C: Integer;
Begin
For I := 0 To Length(a) - 2 Do
Begin
If Distance(a[i].x, a[i].y, from.x, from.y) > Distance(a[i + 1].x, a[i + 1].y, from.x, from.y) Then
Begin
C := I;
Repeat
tSwap(a[c], a[c + 1]);
if c < 1 then
break;
c := c - 1;
Until Distance(a[c].x, a[c].y, from.x, from.y) < Distance(a[c + 1].x, a[c + 1].y, from.x, from.y)
End;
End
End;
Procedure SortATPAFrom(Var a: TPointArrayArray; const From: TPoint); stdcall;
Var
I: Integer;
Begin
For I := 0 To Length(a) - 1 Do
SortTPAFrom(a[i], From);
End;
Procedure SortATPAFromFirstPoint(Var a: TPointArrayArray; const From: TPoint); stdcall;
Var
I, C: Integer;
Begin
For I := 0 To Length(a) - 2 Do
Begin
If Distance(a[i][0].x, a[i][0].y, from.x, from.y) > Distance(a[i + 1][0].x, a[i + 1][0].y, from.x, from.y) Then
Begin
C := I;
Repeat
tpaSwap(a[c], a[c + 1]);
if c < 1 then
break;
c := c - 1;
Until Distance(a[c][0].x, a[c][0].y, from.x, from.y) < Distance(a[c + 1][0].x, a[c + 1][0].y, from.x, from.y)
End;
End
End;
Procedure InvertTPA(Var a: TPointArray); stdcall;
Var
I: Integer;
Begin
For I := 0 To Length(a) Shr 1 Do
tSwap(a[i], a[Length(a) - I - 1]);
End;
Procedure InvertATPA(Var a: TPointArrayArray); stdcall;
Var
I: Integer;
Begin
For I := 0 To Length(a) - 1 Do
InvertTPA(a[i]);
End;
Function MiddleTPA(tpa: TPointArray): TPoint; stdcall;
Var
I: Integer;
Begin
If Length(tpa) < 1 Then
Exit;
Result.X := 0;
Result.Y := 0;
For I := 0 To Length(tpa) - 1 Do
Begin
Result.X := Result.X + tpa[I].X;
Result.Y := Result.Y + tpa[I].Y;
End;
Result.X := Result.X Div Length(tpa);
Result.Y := Result.Y Div Length(tpa);
End;
//********************************
// Change this accordingly to your function count
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 11;
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 := @InvertATPA;
StrPCopy(ProcDef, 'Procedure InvertATPA(Var a: TPointArrayArray);');
end;
1:
begin
ProcAddr := @InvertTPA;
StrPCopy(ProcDef, 'Procedure InvertTPA(Var a: TPointArray);');
end;
2:
begin
ProcAddr := @MiddleTPA;
StrPCopy(ProcDef, 'Function MiddleTPA(tpa: TPointArray): TPoint;');
end;
3:
begin
ProcAddr := @NearbyPointInArray;
StrPCopy(ProcDef, 'Function NearbyPointInArray(P: TPoint; Dist:Integer; a: TPointArray): Boolean;');
end;
4:
begin
ProcAddr := @RAaSTPA;
StrPCopy(ProcDef, 'procedure RAaSTPA(Var a: TPointArray; Dist: Integer);');
end;
5:
begin
ProcAddr := @ReArrangeAndShortenArray;
StrPCopy(ProcDef, 'Function ReArrangeAndShortenArray(a: TPointArray; Dist: Integer): TPointArray;');
end;
6:
begin
ProcAddr := @SortATPAFrom;
StrPCopy(ProcDef, 'Procedure SortATPAFrom(Var a: TPointArrayArray; From: TPoint);');
end;
7:
begin
ProcAddr := @SortATPAFromFirstPoint;
StrPCopy(ProcDef, 'Procedure SortATPAFromFirstPoint(Var a: TPointArrayArray; From: TPoint);');
end;
8:
begin
ProcAddr := @SortTPAFrom;
StrPCopy(ProcDef, 'Procedure SortTPAFrom(Var a: TPointArray; From: TPoint);');
end;
9:
begin
ProcAddr := @tpaSwap;
StrPCopy(ProcDef, 'Procedure tpaSwap(Var a, b: TPointArray);');
end;
10:
begin
ProcAddr := @TPAtoATPA;
StrPCopy(ProcDef, 'Function TPAtoATPA(TPA: TPointArray; Dist: Integer): TPointArrayArray;');
end;
else
x := -1;
end;
Result := x;
end;
//********************************
// Change this accordingly to your type count
function GetTypeCount(): Integer; stdcall; export;
begin
Result := 1;
end;
//*******************************
// Types you want to add
function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
case x of
0:
begin
sType := 'TPointArrayArray';
sTypeDef := 'Array of TPointArray';
end;
else
x := -1;
end;
Result := x;
end;
//***************************
// Don't change below this
exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;
end.