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