Edge detection

[J J]

Currently working on speeding it up as the full mainscreen takes around 10 seconds or so. Let me know if you have any idea's on how to speed it up. The code:

Fill in your desired coordinates where it should detect the edges and the threshold. Will show a debug of where it searches for and will draw the result in SMART.
program Edge;
{$DEFINE SMART}
{$i srl/srl.simba}
{$i srl/srl/misc/paintsmart.simba}
{$loadlib irokiplugin}

procedure DeclarePlayers;
begin
HowManyPlayers := 1;
NumberOfPlayers(HowManyPlayers);
CurrentPlayer := 0;

with Players[0] do
begin
Name := '';
Pass := '';
Pin := '';
Active := True;
end;
end;

procedure SetupLogin;
begin
ClearDebug;
Smart_Server := 10;
Smart_Members := False;
Smart_Signed := True;
Smart_SuperDetail := False;
SetupSRL;
DeclarePlayers;
LoginPlayer;
end;

procedure Edges(X1, Y1, X2, Y2, Threshold: Integer);
var
Width, Height, ClientBMP, i, a, b: Integer;
Colors: TIntegerArray;
ColorCoords, Edge: TPointArray;
Box: TBox;

begin
// Making a bmp and showing in debug box
Box := IntToBox(X1, Y1, X2, Y2);
Width := Box.X2-Box.X1;
Height := Box.Y2-Box.Y1;
DisplayDebugImgWindow(Width, Height);
ClientBMP := BitmapFromClient(Box.X1, Box.Y1, Box.X2, Box.Y2);
DrawBitmapDebugImg(ClientBMP);
FreeBitmap(ClientBMP);

// Grabbing all the colors and asigning a TPoint to them.
Colors := GetColorsBox(Box.X1, Box.Y1, Box.X2, Box.Y2, False);
SetLength(ColorCoords, Length(Colors));
for i:=0 to high(Colors) do
begin
if a > (Box.Y2-Box.Y1) then
begin
a := 0;
Inc(b);
end;
ColorCoords[i] := Point(Box.X1+b, Box.Y1+a);
Inc(a);
end;

// Finding the edges
for i:=0 to high(Colors)-1 do
begin
// Checking R value
if Abs((Colors[i] and $ff) - (Colors[i+1] and $ff)) > Threshold then
begin
SetLength(Edge, Length(Edge)+1);
Edge[Length(Edge)-1] := ColorCoords[i];
Continue;
end;

// Checking G value
if Abs((Colors[i] shr 8 and $ff) - (Colors[i+1] shr 8 and $ff)) > Threshold then
begin
SetLength(Edge, Length(Edge)+1);
Edge[Length(Edge)-1] := ColorCoords[i];
Continue;
end;

//Checking B value
if Abs((Colors[i] shr 16 and $ff) - (Colors[i+1] shr 16 and $ff)) > Threshold then
begin
SetLength(Edge, Length(Edge)+1);
Edge[Length(Edge)-1] := ColorCoords[i];
Continue;
end;
end;

// Drawing the edges
SMART_DrawDotsEx(True, TPAFromBox(Box), RGBtoColor(1, 1, 1));
SMART_DrawDotsEx(False, Edge, RGBToColor(255, 255, 255));
end;

begin
SetUpLogin;
Edges(100, 15, 420, 310, 4);
end.

Some results:
http://img443.imageshack.us/img443/8307/edgedetected3.png
http://img822.imageshack.us/img822/8697/edgedetected2.png

Should be useful, but it isn't that fast right now for loads of pixels. Not sure if I can make it faster in Simba, I would probably need to write a plugin to make it faster? :P Enjoy.

[Ezio Auditore da Firenze]

Always such quality work! Well done! :)

[Olly]

As always JJ this is amazing, but how would you use this?

[Flight]

Looking nice indeed. So this is like the canny core then?

[J J]

Always such quality work! Well done! :)
Thanks :P


As always JJ this is amazing, but how would you use this?
Yeah that is also one of the reasons I posted this, looking for some input of others. I was thinking of letting simba calculate the outlines that are missing or something, but I'm not sure how good that would work :P


Looking nice indeed. So this is like the canny core then?
Yes, it gives pretty accurate results. I think they the results are similar to canny core results.

[tls]

Throw it in a plugin, its like meth for functions like this :)

[nielsie95]

There are some optimizations you could try, but a plugin will be a lot faster. I also tried it in Lape (no changes to the code needed, but you need the Lape branch for SRL) and it's a lot faster :) Your example executes in about 125ms (without the SMART painting).

[tls]

There are some optimizations you could try, but a plugin will be a lot faster. I also tried it in Lape (no changes to the code needed, but you need the Lape branch for SRL) and it's a lot faster :) Your example executes in about 125ms (without the SMART painting).

Have you committed the latest Lape version to github? I've just got my desktop setup again, looking to develop some stuff :)

[nielsie95]

Latest Lape should be in the latest release candidate of Simba.

[J J]

I've never made a plugin before, but I guess by following this tutorial I should be able to make one?
http://villavu.com/forum/showthread.php?t=58815

The main "problem" is the speed. If I could indeed make it 125 ms instead of ~10 secs it would be great :P I think I'll work on making it more accurate right now with a slow speed, and then I'll convert it to a plugin or something :P

[Joe]

This looks awesome. Could this be used for other things or is it too slow.
I'm sure you will have this perfected in no time.

[tls]

Latest Lape should be in the latest release candidate of Simba.

Ok thanks.

[masterBB]

I've never made a plugin before, but I guess by following this tutorial I should be able to make one?
http://villavu.com/forum/showthread.php?t=58815

The main "problem" is the speed. If I could indeed make it 125 ms instead of ~10 secs it would be great :P I think I'll work on making it more accurate right now with a slow speed, and then I'll convert it to a plugin or something :P

We just got a new plugin format. ABI 2 I believe.

Here is the documentation:
http://docs.villavu.com/simba/simbaref/plugins.html

Just install lazarus and adjust that last example to withhold your functions. I made a small start on chrome, so I didn't test it.

{ Example based upon the SPS Plugin }
library project1;

{$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;

function Edges(X1, Y1, X2, Y2, Threshold: Integer):TPointArray;
begin
//Your edge function

//I suggest asking for a bitmap as parameters instead of coords so this plugin doesn't have to use mml
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);
end;

function GetTypeCount(): Integer; callconv export;
begin
Result := 0; //you didn't create a type
end;

function GetTypeInfo(x: Integer; var sType, sTypeDef: PChar): integer; callconv export;
begin
Result := 0; //you didn't create a type
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 := @Edges;
StrPCopy(ProcDef, 'function Edges(X1, Y1, X2, Y2, Threshold: Integer):TPointArray;');
end;

else
x := -1;
end;

Result := x;
end;

exports GetPluginABIVersion;
exports SetPluginMemManager;
exports GetTypeCount;
exports GetTypeInfo;
exports GetFunctionCount;
exports GetFunctionInfo;
exports OnDetach;

begin
end.

[J J]

I see, thanks MasterBB :P I'm going on holiday in 2 days so yeah.. I hope to improve this before going on holiday xD And Joe, if I would transform it to a plugin (or someone else) it would be fast enough to use.

[Bobarkinator]

I see, thanks MasterBB :P I'm going on holiday in 2 days so yeah.. I hope to improve this before going on holiday xD And Joe, if I would transform it to a plugin (or someone else) it would be fast enough to use.

Like Nielsie said, if you put it in Lape it goes down to 125ms. With a few optimizations that seems an acceptable speed.

[masterBB]

Like Nielsie said, if you put it in Lape it goes down to 125ms. With a few optimizations that seems an acceptable speed.

Though how awesome that might be, and that surely is the future if the piece of code will be used. Till simba 1.0 is out I thought we would stick to pascalscript?

[Bobarkinator]

Though how awesome that might be, and that surely is the future if the piece of code will be used. Till simba 1.0 is out I thought we would stick to pascalscript?

I say the more people we get coding stuff in Lape, the faster we'll switch over to it ;)

[Sirenia]

Whats the good stuff with Lape and why isnt pascalscript good enough?

[Bobarkinator]

Whats the good stuff with Lape and why isnt pascalscript good enough?

Pascalscript is slow, only available on Windows, and prone to bugs.

Lape was written by Nielsie, works cross-platform, and is a heck of a lot faster.

[Home]

I'v got the time reduced from 10 Secs to 4 Seconds for MainScreen, I will look into this more and post results.

~Home

[masterBB]

Pascalscript is slow, only available on Windows, and prone to bugs.

Lape was written by Nielsie, works cross-platform, and is a heck of a lot faster.

Comparing lape with pascalscript is like comparing Yvonne Strahovski with Sarah Jessica Parker. Lape is so much better.


Lape is one billion to the power of one billion times faster.
Lape support pointers.
Lape is one billion to the power of one billion times faster.
Lape supports type functions and methods.
Lape is one billion to the power of one billion times faster.
Lape can overload and override functions and procedures.
Lape is one billion to the power of one billion times faster.
Lape won't hog your memory when you use the TPA functions like FindTPARows.
Lape is one billion to the power of one billion times faster.
Lape is a nice compiler instead of the that scumbag pascalscript since it doesn't matter if the computer is linux or windows or even mac. It will run perfectly.
Lape is one billion to the power of one billion times faster.
Lape is predictable.
Lape is one billion to the power of one billion times faster.
We can fix bugs with lape.
Lape is one billion to the power of one billion times faster.
Did I mentioned how fast it is?

[J J]

I'v got the time reduced from 10 Secs to 4 Seconds for MainScreen, I will look into this more and post results.

~Home
Great, I'm currently looking at ways of using the edges to detect objects. I can probably leave the other stuff to you guys as you have more experience with writing plug ins etc. Also the fact that I'm going on holiday in 2 days.. :P

[Home]

Made some modifcations, still can be made faster :)

program new;
{$DEFINE SMART}
{$i srl/srl.simba}
{$i srl/srl/misc/paintsmart.simba}
{$loadlib irokiplugin}


var
C :Integer;

procedure DeclarePlayers;
begin
HowManyPlayers := 1;
NumberOfPlayers(HowManyPlayers);
CurrentPlayer := 0;

with Players[0] do
begin
Name := '';
Pass := '';
Pin := '';
Active := True;
end;
end;

procedure SetupLogin;
begin
Smart_Server := 10;
Smart_Members := False;
Smart_Signed := True;
Smart_SuperDetail := False;
SetupSRL;
DeclarePlayers;
LoginPlayer;
end;

procedure Edges(X1, Y1, X2, Y2, Threshold: Integer);
var
Numb, Hi, Width, Height, ClientBMP, i, a, b: Integer;
Colors: TIntegerArray;
ColorCoords, Edge: TPointArray;
Box: TBox;

begin
// Making a bmp and showing in debug box
Box := IntToBox(X1, Y1, X2, Y2);
Width := Box.X2 - Box.X1;
Height := Box.Y2 - Box.Y1;
ClientBMP := BitmapFromClient(Box.X1, Box.Y1, Box.X2, Box.Y2);
FreeBitmap(ClientBMP);

// Grabbing all the colors and asigning a TPoint to them.
Colors := GetColorsBox(Box.X1, Box.Y1, Box.X2, Box.Y2, False);
ColorCoords := TPAFromBox(IntToBox(X1, Y1, X2, Y2));
Hi := Length(Colors)

// Finding the edges
for i := 0 to Hi - 2 do
begin
Numb := i mod 3 * 8
if Abs((Colors[i] shr Numb and $ff) - (Colors[i + 1] shr Numb and $ff)) > Threshold then
begin
SetLength(Edge, Length(Edge) + 1);
Edge[Length(Edge) - 1] := ColorCoords[i];
end;
end;

// Drawing the edges
SMART_DrawDotsEx(True, TPAFromBox(Box), RGBtoColor(1, 1, 1));
SMART_DrawDotsEx(False, Edge, RGBToColor(255, 255, 255));
end;



begin
SetUpLogin;
MarkTime(C);
Edges(MSX1, MSY1, MSX2, MSY2, 4);
writeln(TimeFromMark(C));
end.

~Home

[nielsie95]

I think your code does something different by looking at the if ;)

[Silentcore]

Is this going to be helpful in the future when randoms all become crazy color change-able?

EDIT: I Suppport!!

[J J]

Thanks Home :)
I forgot / didn't realize that TPAFromBox uses the same pattern as GetColorsBox.. Should be pretty obvious but somehow I forgot about that, that is indeed a lot faster than using the code that I wrote for that.

What about this
Numb := i mod 3 * 8;

What does that do? You need as results 0, 1, 2 so I guess mod rounds it down to the nearest or something? Otherwise I have no idea why it works :P I'm experimentating with RAaSTPA atm.

[Olly]

Is this going to be helpful in the future when randoms all become crazy color change-able?

EDIT: I Suppport!!

That's where OpenGL could work wonders :P but in the mean time yes this could be very useful for randoms.

[Home]

I think your code does something different by looking at the if ;)

Tell me, I did it while watching House :)

Edit.. Got it damn I'm a moron..

JJ, forget the version I posted, why it's faster because I failed, I didn't loop it enough..
Edit.. Hold on, Now I screwed my whole code. Anyways, JJ above code of mine is wrong :(
Don't use it, use yours and replace some of the functions that you are using so you can cut couple seconds off.
To be honest, I don't believe that PS is enough fast.. We need to make plugin or the ditch PS to hell ;)

~Home

[J J]

Tell me, I did it while watching House :)

Edit.. Got it damn I'm a moron..

JJ, forget the version I posted, why it's faster because I failed, I didn't loop it enough..
:P

~Home
Hm I've actually used your code and it worked pretty well, probably because the R values are very different.. :P
EDIT: But I'll use the latest part from this code below in my function that compares all the values.

Made some slight modifications and it now connects the points
First making RAaSTPA then connecting those

http://img171.imageshack.us/img171/7393/edgev4.png

program new;
{$DEFINE SMART}
{$i srl/srl.simba}
{$i srl/srl/misc/paintsmart.simba}
{$loadlib irokiplugin}

var
C :Integer;

procedure DeclarePlayers;
begin
HowManyPlayers := 1;
NumberOfPlayers(HowManyPlayers);
CurrentPlayer := 0;

with Players[0] do
begin
Name := '';
Pass := '';
Pin := '';
Active := True;
end;
end;

procedure SetupLogin;
begin
Smart_Server := 10;
Smart_Members := False;
Smart_Signed := True;
Smart_SuperDetail := False;
SetupSRL;
DeclarePlayers;
LoginPlayer;
end;

procedure Edges(X1, Y1, X2, Y2, Threshold: Integer);
var
Numb, Nearest, i, a: Integer;
Difference, Lowest: Extended;
Colors: TIntegerArray;
ColorCoords, Edge: TPointArray;

begin
// Grabbing all the colors and asigning a TPoint to them.
Colors := GetColorsBox(X1, Y1, X2, Y2, False);
ColorCoords := TPAFromBox(IntToBox(X1, Y1, X2, Y2));

// Finding the edges
for i := 0 to (Length(Colors) - 2) do
begin
Numb := i mod 3 * 8;
if Abs((Colors[i] shr Numb and $ff) - (Colors[i + 1] shr Numb and $ff)) > Threshold then
begin
SetLength(Edge, Length(Edge) + 1);
Edge[Length(Edge) - 1] := ColorCoords[i];
end;
end;

// Drawing the edges
SMART_DrawDotsEx(True, TPAFromBox(IntToBox(X1, Y1, X2, Y2)), RGBtoColor(1, 1, 1));
RAaSTPA(Edge, 10);
SMART_DrawDotsEx(False, Edge, clGreen);
Wait(5000);

// Calculating the lines to connect the points
for i:=0 to high(Edge) do
begin
Lowest := 10000;
for a:=0 to high(Edge) do
begin
Difference := (Abs(Edge[a].X - Edge[i].X) + Abs(Edge[a].Y - Edge[i].Y));
if (Difference < Lowest) and (Difference > 0) then
begin
Lowest := Difference;
Nearest := a;
end;
end;
SMART_DrawLine(False, Edge[i], Edge[Nearest], clWhite);
end;
end;

begin
SetUpLogin;
MarkTime(C);
Edges(MSX1, MSY1, MSX2, MSY2, 6);
Writeln(TimeFromMark(C));
end.


EDIT 2: This isn't really about this function, but more about Leo. For Leo I would need to grab the colors at the right point when the object is rotated right. Anyone with an idea how to make that? But this topic is more about the edge detection than Leo, but I've made it to use with the Leo Random :P

[Bobarkinator]

Thanks Home :)
I forgot / didn't realize that TPAFromBox uses the same pattern as GetColorsBox.. Should be pretty obvious but somehow I forgot about that, that is indeed a lot faster than using the code that I wrote for that.

What about this
Numb := i mod 3 * 8;

What does that do? You need as results 0, 1, 2 so I guess mod rounds it down to the nearest or something? Otherwise I have no idea why it works :P I'm experimentating with RAaSTPA atm.

I don't know if you were asking what mod does, but it's short for modulo and what it does is return the remainder of division by that number.

http://en.wikipedia.org/wiki/Modulo_operation

[Zyt3x]

Don't know if this is still relevant, but I made something you might find some use for some months ago..

(Used your picture of the gravedigger thing)
Parameters 2, 0, 255, false: http://i.imgur.com/XsBH9cM.png
Parameters 2, 150, 255, false: http://i.imgur.com/NyUxYuu.png
Parameters 2, 250, 255, true: http://i.imgur.com/oj9R9y1.png
Takes about 400ms to complete for that 254x248 bitmap, though....
function findEdges(const bmp : Integer; const divider : Integer = 4; const minValue : Integer = 0; const maxValue : Integer = 255; const noColor : Boolean = false): Integer;
var
W, H, X, Y, I, C, D : Integer;
cR, cG, cB : Integer;
dR, dG, dB : array [0..8] of Integer;
rR, rG, rB : Integer;
dTPA := [point(-1, -1), point(0, -1), point(1, -1),
point(-1, 0), point(1, 0),
point(-1, 1), point(0, 1), point(1, 1)];
begin
getBitmapSize(bmp, W, H);
result := createBitmap(W, H);
for Y := 1 to H-2 do
for X := 1 to W-2 do
begin
C := fastGetPixel(bmp, X, Y);
colorToRGB(C, cR, cG, cB);
for I := 0 to 8 do
colorToRGB(fastGetPixel(bmp, X + dTPA[I].X, Y + dTPA[I].Y), dR[I], dG[I], dB[I]);
rR := abs(averageTIA(dR) - cR);
rG := abs(averageTIA(dG) - cG);
rB := abs(averageTIA(dB) - cB);
rR := floor(rR * (rR / divider));
rG := floor(rG * (rG / divider));
rB := floor(rB * (rB / divider));
rR := max(minValue, min(maxValue, rR));
rG := max(minValue, min(maxValue, rG));
rB := max(minValue, min(maxValue, rB));
if rR = minValue then rR := 0;
if rG = minValue then rG := 0;
if rB = minValue then rB := 0;
if noColor then rR := rG := rB := max(rR, max(rG, rB));
fastSetPixel(result, X, Y, RGBToColor(rR, rG, rB));
end;
end;