SRL Archive - OSR Help

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


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.

Procedure FilterPointsLine(var Points: TPointArray; Radial, Radius: Extended; MX, MY: LongInt);
begin
  FilterPointsPie(Points, Radial, Radial, 0, Radius, MX, MY);
end;

From: MylesMadness

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.

So something like this? and you would want only the points of the black line?

From: MylesMadness
So something like this? and you would want only the points of the black line?

Yes, exactly.

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;

Like this?

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..

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;

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).

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.

From: bullzeye95
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.

http://www.megaupload.com/?d=JVH27A10

Using:

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;

From: r!ch!e
http://www.megaupload.com/?d=JVH27A10

Using:

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.

Edit:

[Runtime Error] : Exception: Access violation at address 021C4C38 in module 'FilterPointsLib.dll'. Write of address 00000014 in line 

That plugin doesn't work either.

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

[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

Any ideas?

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.

type
  TPointArray = array of TPoint;
  TBox = record
  x1, x2, y1, y2: integer;
  end;

Should be:

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!

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.

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

From: Nava2

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.

bulleye's uses radians? does yours? that could be a problem putting in radians for degrees you know :duh:

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;

Faster?

:0!

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

procedure CreateLine(out tpa: TPointArray; radial: Extended; radius, cx, cy: Integer);
var
  r: Extended;
  ex, sx, x: Integer;
begin
  r := Tan(radial);
  if (Abs(r) <= 1) then
  begin
    ex := Round(Cos(radial) * radius);
    SetLength(tpa, iAbs(ex) + 1);

    sx := Min(0, ex);
    ex := Max(0, ex);

    for x := sx to ex do
    begin
      tpa[-sx + x] := Point(cx + x, cy + Round(x * r));
    end;
  end
  else
  begin
    ex := Round(Sin(radial) * radius);
    SetLength(tpa, iAbs(ex) + 1);
    
    sx := Min(0, ex);
    ex := Max(0, ex);
    
    for x := sx to ex do
    begin
      tpa[-sx + x] := Point(cx + Round(x / r), cy + x);
    end;
  end;
end;

I would hazard a guess that this method of point producing is faster since the main looping only involves 1 multiply or divide. It should produce a reasonable line and if you wanted filtering rather than creating, you could also adapt it to use Bullzeye's filtering method.