mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-11 01:52:16 -05:00
b339f58027
Algorithm may change over time and will stabilize on release of 0.98, there is room for speed improvements.
140 lines
2.5 KiB
ObjectPascal
140 lines
2.5 KiB
ObjectPascal
program project1;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
uses
|
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
|
cthreads,
|
|
{$ENDIF}{$ENDIF}
|
|
Classes, SysUtils, CustApp,
|
|
interfaces, // to prevent linking errors. :|
|
|
|
|
client, MufasaTypes,
|
|
|
|
lclintf;
|
|
|
|
type
|
|
|
|
{ TMMLBenchmark }
|
|
|
|
TMMLBenchmark = class(TCustomApplication)
|
|
protected
|
|
procedure DoRun; override;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure WriteHelp; virtual;
|
|
end;
|
|
|
|
var
|
|
bmp: Integer;
|
|
|
|
MMLClient: TClient;
|
|
{ TMMLBenchmark }
|
|
|
|
procedure init;
|
|
|
|
begin
|
|
MMLClient := TClient.Create('');
|
|
|
|
bmp := MMLClient.MBitmaps.CreateBMP(0, 0);
|
|
MMLClient.MBitmaps.GetBMP(bmp).LoadFromFile('/home/merlijn/Programs/simba/wall.bmp');
|
|
MMLClient.IOManager.SetTarget(MMLClient.MBitmaps[bmp]);
|
|
end;
|
|
|
|
procedure free;
|
|
begin
|
|
MMLClient.IOManager.SetDesktop;
|
|
MMLClient.MBitmaps.FreeBMP(bmp);
|
|
MMLClient.Free;
|
|
end;
|
|
|
|
procedure Benchmark;
|
|
|
|
var
|
|
t, t2, t3: PtrUInt;
|
|
i, c, w, h: integer;
|
|
col, tol: integer;
|
|
|
|
dummytpa: TPointArray;
|
|
|
|
begin
|
|
init;
|
|
t := gettickcount;
|
|
MMLClient.IOManager.GetDimensions(w, h);
|
|
|
|
col := 16777215; tol := 30;
|
|
|
|
for c := 0 to 3 do // benchmark all CTS'es
|
|
begin
|
|
MMLClient.MFinder.SetToleranceSpeed(c);
|
|
t2 := gettickcount;
|
|
for i := 0 to 100 do
|
|
begin
|
|
MMLClient.MFinder.FindColorsTolerance(dummytpa, col, 0, 0, w-1,h-1, tol);
|
|
end;
|
|
t3 := gettickcount;
|
|
writeln(format('FindColorsTolerance'+#10+
|
|
'Time spent: %d ms (per %f ms), matches: %d, CTS: %d, Colour: %d, Tolerance %d',
|
|
[t3-t2, (t3-t2) / 100.0, length(dummytpa), c, col, tol]));
|
|
end;
|
|
|
|
free;
|
|
end;
|
|
|
|
procedure TMMLBenchmark.DoRun;
|
|
var
|
|
ErrorMsg: String;
|
|
begin
|
|
// quick check parameters
|
|
ErrorMsg:=CheckOptions('h','help');
|
|
if ErrorMsg<>'' then begin
|
|
ShowException(Exception.Create(ErrorMsg));
|
|
Terminate;
|
|
Exit;
|
|
end;
|
|
|
|
// parse parameters
|
|
if HasOption('h','help') then begin
|
|
WriteHelp;
|
|
Terminate;
|
|
Exit;
|
|
end;
|
|
|
|
Benchmark;
|
|
|
|
{ add your program here }
|
|
|
|
// stop program loop
|
|
Terminate;
|
|
end;
|
|
|
|
constructor TMMLBenchmark.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
StopOnException:=True;
|
|
end;
|
|
|
|
destructor TMMLBenchmark.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMMLBenchmark.WriteHelp;
|
|
begin
|
|
{ add your help code here }
|
|
writeln('Usage: ',ExeName,' -h');
|
|
end;
|
|
|
|
var
|
|
Application: TMMLBenchmark;
|
|
|
|
{$R *.res}
|
|
|
|
begin
|
|
Application:=TMMLBenchmark.Create(nil);
|
|
Application.Run;
|
|
Application.Free;
|
|
end.
|
|
|