Printable View
I'm trying to make a function that is like FilterPointsPie, except instead of radial slices, it just uses a 1 width line like below
http://i50.tinypic.com/91i3py.jpg
I just basically need it to filter out the points in a TPA to only ones that would be on that line
Parameters would be
FilterPointsLine(var Points: TPointArray; Radial, Radius: Extended; MX, MY: LongInt);
Points being the TPA
Radial being the angle
Radius being the length
MX, MY being the center origin.
SCAR Code:Procedure FilterPointsLine(var Points: TPointArray; Radial, Radius: Extended; MX, MY: LongInt);
begin
FilterPointsPie(Points, Radial, Radial, 0, Radius, MX, MY);
end;
That won't work it will sometimes be as wide as 3 and a small as 0 pixels... I need an actual line.Quote:
Originally Posted by MylesMadness
So something like this? http://i49.tinypic.com/mm3qj5.png and you would want only the points of the black line?
Yes, exactly.Quote:
Originally Posted by MylesMadness
Like this?SCAR Code:procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
var
I, II, Hi, Ind, x, y: Integer;
P: TPointArray;
begin
Hi:= High(Points);
SetLength(P, Hi + 1);
for I:= 0 to Radius do
begin
x:= Round(sin(Radial) * I) + MX;
y:= -Round(cos(Radial) * I) + MY;
for II:= 0 to Hi do
if(Points[II].x = x)then if(Points[II].y = y)then
begin
P[Ind]:= Point(x, y);
inc(Ind);
end;
end;
Points:= P;
end;
Yea I guess, but it's slow as hell... like 30 minutes vs 0.1 seconds
Would this be easy to move into a delphi plugin?
I'm looping this 180/360 times btw..
Much faster, but it does not retain multiple points that are on the same pixel (like if there are two points at 25, 25, it will only return one point there).SCAR Code:procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
var
I, Hi, Ind, y: Integer;
P: TPointArray;
Box: TBox;
B: Array of Array of Boolean;
begin
Box:= GetTPABounds(Points);
SetLength(B, max(Box.x2, Round(sin(Radial) * Radius + MX)) + 1);
y:= max(Box.x2, -Round(cos(Radial) * Radius) + MY);
for I:= 0 to High(B) do
SetLength(B[I], y + 1);
Hi:= High(Points);
for I:= 0 to Hi do
B[Points[I].x][Points[I].y]:= True;
SetLength(P, Hi + 1);
for I:= 0 to Radius do
begin
if(B[Round(sin(Radial) * I) + MX][-Round(cos(Radial) * I) + MY])then
begin
P[Ind]:= Point(Round(sin(Radial) * I) + MX, -Round(cos(Radial) * I) + MY);
inc(Ind);
end;
end;
SetLength(P, Ind);
Points:= P;
end;
Still slow man... I'll be dead in that time. There has to be a way, how does FilterPointsPie do 360 loops in miliseconds?
I missed your question about putting it in a plugin... It would be very easy, and if you did it, it should be able to do those loops in a few milliseconds.
I'd do it for you, but I don't have Delphi installed right now.
I have delphi 7SE, and I know how to make dll or whatever.. I would just need the source or close to it.Quote:
Originally Posted by bullzeye95
http://www.megaupload.com/?d=JVH27A10
Using:
Code:procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);
var
I, Hi, Ind, y: Integer;
P: TPointArray;
Box: TBox;
B: Array of Array of Boolean;
begin
Box:= GetTPABounds(Points);
SetLength(B, max(Box.x2, Round(sin(Radial) * Radius + MX)) + 1);
y:= max(Box.x2, -Round(cos(Radial) * Radius) + MY);
for I:= 0 to High(B) do
SetLength(B[I], y + 1);
Hi:= High(Points);
for I:= 0 to Hi do
B[Points[I].x][Points[I].y]:= True;
SetLength(P, Hi + 1);
for I:= 0 to Radius do
begin
if(B[Round(sin(Radial) * I) + MX][-Round(cos(Radial) * I) + MY])then
begin
P[Ind]:= Point(Round(sin(Radial) * I) + MX, -Round(cos(Radial) * I) + MY);
inc(Ind);
end;
end;
Points:= P;
end;
I kinda need the whole source.Quote:
Originally Posted by r!ch!e
Edit:That plugin doesn't work either.Code:[Runtime Error] : Exception: Access violation at address 021C4C38 in module 'FilterPointsLib.dll'. Write of address 00000014 in line
Ok guys, I used bullzeyes first method below in a plugin but I still get a runtime error when I try and use it in SCAR
Any ideas?Quote:
[Runtime Error] : Exception: Access violation at address 01EB8A7D in module 'RCrB_Plugin.dll'. Write of address 057A8C98 in line 40 in script C:\Documents and Settings\James\My Documents\SCAR 3.23 Beta\Scripts\Abyssaldetection.scar
SCAR Code:library RCrB_Plugin;
uses
FastShareMem,
SysUtils,
Windows,
Math;
{$R *.res}
type
TPointArray = array of TPoint;
TBox = record
x1, x2, y1, y2: integer;
end;
procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); stdcall;
var
I, II, Hi, Ind, x, y: Integer;
P: TPointArray;
begin
Hi:= High(Points);
SetLength(P, Hi + 1);
for I:= 0 to Radius do
begin
x:= Round(sin(Radial) * I) + MX;
y:= -Round(cos(Radial) * I) + MY;
for II:= 0 to Hi do
if(Points[II].x = x)then if(Points[II].y = y)then
begin
P[Ind].X := X;
P[Ind].Y := Y;
inc(Ind);
end;
end;
Points:= P;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 1;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:begin
ProcAddr := @FilterPointsLine;
StrPCopy(ProcDef, 'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);');
end;
else
x := -1;
end;
Result := x;
end;
exports GetFunctionCount;
exports GetFunctionInfo;
end.
Should be:Code:type
TPointArray = array of TPoint;
TBox = record
x1, x2, y1, y2: integer;
end;
Code:type
TPoint = record
x, y: Integer;
end;
TBox = record
x1, y1, x2, y2: Integer;
end;
TPointArray = array of TPoint;
Ok I did that, and I initialized the Ind var with := 0;
It can run now... but it's verry slow still and my SCAR keeps bugging up and crashing.
I really need a solution to this.
Use my second method. It's hundreds of times faster.
Yeah, I was messing around with it and I blue screened :( Lost some of my Exam Review ..
I can't think of anything right now, but i'll look into it later.
Edit: The second method is the DLL I provided, but fails to work.
Had to restart my comp because I messed around with delphi to much
I finally got this: (see below)
It's still overall 500ms slower than using FilterPointsPie, but it gets the job done :D
If anyone can tell me a way to make it go faster by any means, please let me know.
Edit: After adding two other functions I am using in the main script I was able to cut down another 1000 ms... it's still around 600ms which is awesome! and will be even less once I move the entire main function into the plugin :) but still if you see any speed improvements let me know!
SCAR Code:library RCrB_Plugin;
uses
FastShareMem,
SysUtils,
Windows,
Math;
{$R *.res}
type
TBox = record
x1, y1, x2, y2: Integer;
end;
TPointArray = array of TPoint;
function GetTPABounds(TPA: TPointArray): TBox; stdcall;
var
I,L : Integer;
begin;
L := High(TPA);
if (l < 0) then Exit;
Result.x1 := TPA[0].x;
Result.y1 := TPA[0].y;
Result.x2 := TPA[0].x;
Result.y2 := TPA[0].y;
for I:= 1 to L do
begin;
if TPA[i].x > Result.x2 then
Result.x2 := TPA[i].x
else if TPA[i].x < Result.x1 then
Result.x1 := TPA[i].x;
if TPA[i].y > Result.y2 then
Result.y2 := TPA[i].y
else if TPA[i].y < Result.y1 then
Result.y1 := TPA[i].y;
end;
end;
procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); stdcall;
var
I, Hi, Ind, y: Integer;
P: TPointArray;
Box: TBox;
B: Array of Array of Boolean;
begin
Ind := 0;
Box:= GetTPABounds(Points);
SetLength(B, max(Box.x2, Round(sin(Radial) * Radius + MX)) + 1);
y:= max(Box.x2, -Round(cos(Radial) * Radius) + MY);
for I:= 0 to High(B) do
SetLength(B[I], y + 1);
Hi:= High(Points);
for I:= 0 to Hi do
B[Points[I].x][Points[I].y]:= True;
SetLength(P, Hi + 1);
for I:= 0 to Radius do
begin
if(B[Round(sin(Radial) * I) + MX][-Round(cos(Radial) * I) + MY])then
begin
P[Ind].X := Round(sin(Radial) * I) + MX;
P[Ind].Y := -Round(cos(Radial) * I) + MY;
inc(Ind);
end;
end;
SetLength(P, Ind);
Points:= P;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 1;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:begin
ProcAddr := @FilterPointsLine;
StrPCopy(ProcDef, 'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);');
end;
else
x := -1;
end;
Result := x;
end;
exports GetFunctionCount;
exports GetFunctionInfo;
end.
delphi Code:library RCrB_Plugin;
uses
FastShareMem,
SysUtils,
Windows,
Math;
{$R *.res}
type
TBox = record
x1, y1, x2, y2: Integer;
end;
TPointArray = array of TPoint;
function GetTPABounds(TPA: TPointArray): TBox; stdcall;
var
I,L : Integer;
begin;
L := High(TPA);
if (l < 0) then Exit;
Result.x1 := TPA[0].x;
Result.y1 := TPA[0].y;
Result.x2 := TPA[0].x;
Result.y2 := TPA[0].y;
for I:= 1 to L do
begin;
if TPA[i].x > Result.x2 then
Result.x2 := TPA[i].x
else if TPA[i].x < Result.x1 then
Result.x1 := TPA[i].x;
if TPA[i].y > Result.y2 then
Result.y2 := TPA[i].y
else if TPA[i].y < Result.y1 then
Result.y1 := TPA[i].y;
end;
end;
procedure FilterPointsLine(out Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); stdcall;
var
I, Hi, Ind, y: Integer;
P: TPointArray;
Box: TBox;
B: Array of Array of Boolean;
sinRadial, cosRadial: Extended;
sinRadMult, cosRadMult: Integer;
begin
Ind := 0;
Box:= GetTPABounds(Points);
sinRadial := sin(Radial);
cosRadial := cos(Radial);
SetLength(B, max(Box.x2, Round(sinRadial * Radius + MX)) + 1);
y:= max(Box.x2, -Round(cosRadial * Radius) + MY);
for I:= High(B) downto 0 do
SetLength(B[I], y + 1);
Hi:= High(Points);
for I:= Hi downto 0 do
B[Points[I].x][Points[I].y]:= True;
SetLength(P, Hi + 1);
for I:= 0 to Radius do
begin
sinRadMult := Round(sinRadial * I) + MX;
cosRadMult := -Round(cosRadial * I) + MY;
if(B[sinRadMult][cosRadMult])then
begin
P[Ind].X := sinRadMult;
P[Ind].Y := cosRadMult;
inc(Ind);
end;
end;
SetLength(P, Ind);
Points:= P;
end;
function GetFunctionCount(): Integer; stdcall; export;
begin
Result := 1;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
case x of
0:begin
ProcAddr := @FilterPointsLine;
StrPCopy(ProcDef, 'procedure FilterPointsLine(out Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);');
end;
else
x := -1;
end;
Result := x;
end;
exports GetFunctionCount;
exports GetFunctionInfo;
end.
Try that, just removed some useless repeated multiplications. Might shave off some time on long runs. Also removed the High() in the loops, as downto gets the initial value, and won't check again. Its going to stay static anyways.
I'd like to know if it actually changed it :p
What ever you did there it nearly killed my computer, PF File usage was at MAX for 10 minutes completely frozen.Quote:
Originally Posted by Nava2
bulleye's uses radians? does yours? that could be a problem putting in radians for degrees you know :duh:
Faster?SCAR Code:procedure FilterPointsLine(out Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); stdcall;
var
I, Ind: Integer;
Box: TBox;
B: Array of Array of Boolean;
sinRadial, cosRadial: Extended;
begin
Ind := 0;
Box:= GetTPABounds(Points);
sinRadial := sin(Radial);
cosRadial := cos(Radial);
SetLength(B, max(Box.x2, Round(sinRadial * Radius + MX)) + 1), max(Box.x2, -Round(cosRadial * Radius) + MY) + 1);
for I:= 0 to Radius do
B[Round(sinRadial * I) + MX][-Round(cosRadial * I) + MY]:= True;
for I:= High(Points) downto 0 do
if(B[Points[I].x][Points[I].y])then
begin
Points[Ind] := Points[I];
inc(Ind);
end;
SetLength(Points, Ind);
end;
:0!
SCAR Code:Procedure FilterPointsLine(out Points: TPointArray; Radial, Radius, MX, MY: LongInt);
Var I, C : Integer;
Begin
For I := Radius DownTo 0 Do
Begin
Inc(C);
SetLength(Points, C);
Points[C-1] := Point(Round(I * Sin(Radial * Pi / 180)) + MX,
Round(-I * Cos(Radial * Pi / 180)) + MY)
End;
End;
^ That just creates a line in TPA, it doesn't check if any of the points are in the TPA, which (when I last talked to Icefire and was asking what he was doing) doesn't matter.
EDIT: Lol me and bullz are doing identical things :p