{Quick Corner Detection: algoryth & code by SKy Scripter, translated to Pascal by beginner5
http://villavu.com/forum/showthread.php?t=80290 }
library corn_det;
{$mode objfpc}{$H+}
{$macro on}
{$define callconv:=
{$IFDEF WINDOWS}{$IFDEF CPU32}cdecl;{$ELSE}{$ENDIF}{$ENDIF}
{$IFDEF LINUX}{$IFDEF CPU32}cdecl;{$ELSE}{$ENDIF}{$ENDIF}
}
uses
classes, sysutils, math
{ you can add units after this };
var
OldMemoryManager: TMemoryManager;
memisset: Boolean = False;
const
clWhite = 16777215;
clBlack = 0;
clRed = 255;
clGreen = 32768;
clBlue = 16711680;
clPurple = 8388736;
clYellow = 65535;
type TPointArray = array of TPoint;
type TIntegerArray = array of integer;
type T2dIntegerArray = array of TIntegerArray;
type TBooleanArray = array of boolean;
type T2sBooleanArray = array of TBooleanArray;
type TStaticIntegerArray = array [0..7] of integer;
const
cx:TStaticIntegerArray = ( 1, 0, -1, 0, 1, 1, -1, -1 );
cy:TStaticIntegerArray = ( 0, 1, 0, -1, -1, 1, 1, -1 );
var
w,h,sx,sy : integer;
cn ,bc :T2sBooleanArray;
adist, filldist, maxd : double;
es,ee : TPoint;
procedure ffillc(x,y : integer;var C :t2dIntegerArray);
var
i ,a,b: integer;
sqrX ,sqrY : double;
begin
bc[y][x] := True;
for i:=0 to 7 do
begin
if (not bc[y+cy[i]][x+cx[i]] )and cn[y+cy[i]][x+cx[i]] then
begin
a := x + cx[i];
b := y + cy[i];
sqrX := Sqr(a - sx);
sqrY := Sqr(b - sy);
adist := (sqrX + sqrY);
if adist < filldist then
ffillc(a,b,c)
else
begin
if (es.x =0) and (es.y = 0) then
es := Point(a,b);
sqrX := Sqr(es.x - a);
sqrY := Sqr(es.y - b);
adist := (sqrX + sqrY);
if maxd < adist then
begin
maxd := adist;
ee := Point(a,b);
end;
end;
end;
end;
end;
procedure edgefill(x,y :integer; var C :t2dIntegerArray);
var i,j,a,b,xx,yy:integer;
begin
c[y][x] := clBlue;
cn[y][x] := True;
for i:=0 to 7 do
begin
xx := x + cx[i];
yy := y + cy[i];
if ((a<w)and(b<h)) and (c[yy][xx] < clwhite) and (not cn[yy][xx]) then
for j:=0 to 7 do
if (c[yy+cy[j]][xx+cx[j]] = clwhite) then
edgefill(a, b, c);
end;
end;
procedure Init(var TPA :TPointArray; var C :t2dIntegerArray);
var
x,y,i,j,TPAcounter,tw,th: integer;
angle1 ,angle2 ,realangle : double;
p :TPoint;
begin
TPAcounter := 0;
for y:= 1 to h-1 do
for x:= 1 to w-1 do
if (c[y][x] < clwhite) then
begin
edgefill(x,y, c);
break;
end;
filldist := Sqr(15); // distance to scan
tw := Length(cn[0]);
th := Length(cn);
for y:= 1 to h-2 do
for x:= 1 to w-2 do
if cn[y][x] then
begin
SetLength(bc,0,0);
SetLength(bc,th,tw);
sx := x;
sy := y;
es := Point(0,0);
ee := Point(0,0);
maxd := 0;
ffillc(x,y ,c);
angle1 := RadToDeg( ArcTan2(y-ee.y , x - ee.x));
angle2 := RadToDeg( ArcTan2(y-es.y , x - es.x));
realangle := Abs(angle2 - angle1);
realangle := Abs(realangle - 180);
if realangle > 42 then
begin
c[y][x] := clred;
inc(TPAcounter);
SetLength(TPA,TPAcounter);
p.x := x;
p.y := y;
TPA[TPAcounter-1] := p;
end;
end;
end;
procedure SetupCD( c : T2dIntegerArray; var resTPA : TPointArray); callconv
var i,j : integer;
begin
w := Length(c[0]);
h := Length(c);
//writeln(Length(resTPA));
SetLength(cn,h,w);
//for i:= 0 to h-1 do //cleaning cn on start
// for j:= 0 to w-1 do
// cn[i][j] := FALSE;
SetLength(bc,h,w);
Init(resTPA,c);
end;
function GetPluginABIVersion: Integer; callconv export;
begin
Result := 2;
end;
procedure SetPluginMemManager(MemMgr : TMemoryManager); callconv export;
begin
if memisset then
exit;
GetMemoryManager(OldMemoryManager);
SetMemoryManager(MemMgr);
memisset := true;
end;
procedure OnDetach; callconv export;
begin
SetMemoryManager(OldMemoryManager);
writeln('Quick Corner Detection: Detach');
end;
procedure OnAttach; callconv export;
begin
writeln('Quick Corner Detection: algoryth & code by SKy Scripter, translation to Pascal and plugin by beginner5');
writeln('http://villavu.com/forum/showthread.php?t=80290');
end;
function GetTypeCount(): Integer; callconv export;
begin
Result := 0;
end;
function GetTypeInfo(x: Integer; var sType, sTypeDef: PChar): integer; callconv export;
begin
result := -1;
end;
function GetFunctionCount(): Integer; callconv export;
begin
Result :=1;
end;
function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; callconv export;
begin
case x of
0: begin
ProcAddr := @SetupCD;
StrPCopy(ProcDef, 'procedure CornerDetection(BitmapAreaColors : T2dIntegerArray;var resTPA :TPointArray);');
end;
else
x := -1;
end;
Result := x;
end;
exports GetPluginABIVersion;
exports SetPluginMemManager;
exports GetTypeCount;
exports GetTypeInfo;
exports GetFunctionCount;
exports GetFunctionInfo;
exports OnDetach;
exports OnAttach;
begin
end.