moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-21 08:45:06 -05:00
Code Issues Releases Wiki Activity

Merge branch 'master' of https://github.com/MerlijnWajer/Simba

Browse Source
This commit is contained in:
Raymond 2011-02-06 14:33:16 +01:00
commit b6a9d32b82
2 changed files with 254 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Projects/libmml/Makefile Normal file
View File

@ -0,0 +1,5 @@
.PHONY: default
default:
/home/merlijn/lazarus/lazbuild libmml.lpi

460
Projects/libmml/libmml.lpr
View File

@ -59,9 +59,11 @@ begin
C := TClient.Create('');
Result := PtrUInt(C);
except on e : Exception do
begin
// FIXME UINT negative
result := PtrUInt(RESULT_ERROR);
set_last_error(e.Message);
set_last_error(e.message);
end;
end;
writeln(format('C: %d, IOManager: %d', [PtrUInt(C), PtrUInt(C.IOManager)]));
end;
@ -72,8 +74,10 @@ begin
try
C.Free;
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.message):
set_last_error(e.message);
end;
end;
end;
@ -148,9 +152,11 @@ begin
C.IOManager.GetMousePos(t.x,t.y);
result := RESULT_OK;
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
end;
end;
end;
{ Set mouse position of client C to point t }
@ -160,9 +166,11 @@ begin
C.IOManager.MoveMouse(t.x,t.y);
result := RESULT_OK;
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
end;
end;
end;
@ -181,13 +189,15 @@ function get_mouse_button_state(C: TClient; But: Integer): Integer; cdecl;
begin
try
if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then
result := MOUSE_DOWN;
result := MOUSE_DOWN
else
result := MOUSE_UP;
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
end;
end;
end;
{ Set the state of a mouse button given client C }
@ -204,9 +214,11 @@ begin
result := RESULT_OK;
end;
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
end;
end;
end;
@ -222,9 +234,11 @@ begin
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
{ Find color on client C in area (x1,y1,x2,y2) and return coordinate (if any) in x, y }
@ -237,9 +251,11 @@ begin
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.Message);
result := RESULT_ERROR;
end;
end;
end;
function find_color_tolerance(C: TClient; var x, y: Integer; color: Integer;
@ -252,9 +268,11 @@ begin
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.Message);
result := RESULT_ERROR;
end;
end;
end;
function find_color_tolerance_optimised(C: TClient; var x, y: Integer;
@ -269,9 +287,11 @@ begin
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
function find_colors(C: TClient; var ptr: PPoint; var len: Integer;
@ -283,16 +303,20 @@ begin
try
C.MFinder.FindColors(TPA, color, x1, y1, x2, y2);
except on e : Exception do
begin
set_last_error(e.Message);
result := RESULT_ERROR;
end;
end;
len := Length(TPA);
if len > 0 then
result := RESULT_OK
result := RESULT_OK
else
setlength(tpa, 0);
exit(RESULT_FALSE);
begin
setlength(tpa, 0);
exit(RESULT_FALSE);
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(tpa, 0);
@ -303,24 +327,26 @@ function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer;
var
TPA: TPointArray;
begin
try
C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol);
except on e : Exception do
try
C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol);
except on e : Exception do
begin
set_last_error(e.Message);
result := RESULT_ERROR;
set_last_error(e.Message);
result := RESULT_ERROR;
end;
end;
len := Length(TPA);
if len > 0 then
result := RESULT_OK
else
begin
setlength(tpa, 0);
exit(RESULT_FALSE);
end;
end;
len := Length(TPA);
if len > 0 then
result := RESULT_OK
else
setlength(tpa, 0);
exit(RESULT_FALSE);
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0);
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0);
end;
function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint;
@ -330,180 +356,184 @@ function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint;
var
TPA: TPointArray;
begin
try
C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol);
except on e : Exception do
try
C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol);
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
len := Length(TPA);
if len > 0 then
result := RESULT_OK
else
setlength(tpa, 0);
exit(RESULT_FALSE);
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0);
end;
len := Length(TPA);
if len > 0 then
result := RESULT_OK
else
begin
setlength(tpa, 0);
exit(RESULT_FALSE);
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0);
end;
function similar_colors(C: TClient; col1, col2, tol: Integer): Integer; cdecl;
begin
if C.MFinder.SimilarColors(col1, col2, tol) then
result := RESULT_OK
else
result := RESULT_FALSE;
try
if C.MFinder.SimilarColors(col1, col2, tol) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_FALSE;
end;
end;
end;
function count_color(C: TClient; out count: Integer;
Color, xs, ys, xe, ye: Integer): Integer; cdecl;
begin
try
try
count := C.MFinder.CountColor(Color, xs, ys, xe, ye);
if count > 0 then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
begin
count := C.MFinder.CountColor(Color, xs, ys, xe, ye);
if count > 0 then
result := RESULT_OK
else
result := RESULT_FALSE;
set_last_error(e.message);
result := RESULT_ERROR;
end;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
function count_color_tolerance(C: TClient; out count: Integer; col: Integer;
xs, ys, xe, ye, tol: Integer): Integer; cdecl;
begin
try
count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol);
except on e : Exception do
try
count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol);
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
if count > 0 then
result := RESULT_OK
else
result := RESULT_FALSE;
end;
if count > 0 then
result := RESULT_OK
else
result := RESULT_FALSE;
end;
function find_color_spiral(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye: Integer): Integer; cdecl;
begin
try
if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
try
if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
end;
function find_color_spiral_tolerance(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye: Integer;
tol: Integer): Integer; cdecl;
begin
try
if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye, tol) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
try
if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye,
tol) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
end;
function find_colored_area(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye, minA: Integer): Integer; cdecl;
begin
try
if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
try
if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
end;
function find_colored_area_tolerance(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye, minA: Integer;
tol: Integer): Integer; cdecl;
begin
try
if C.MFinder.FindColoredAreaTolerance(x, y, col,
xs, ys, xe, ye, minA, tol) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
try
if C.MFinder.FindColoredAreaTolerance(x, y, col,
xs, ys, xe, ye, minA, tol) then
result := RESULT_OK
else
result := RESULT_FALSE;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
end;
function set_tolerance_speed(C: TClient; nCTS: Integer): Integer; cdecl;
begin
try
try
C.MFinder.SetToleranceSpeed(nCTS);
result := RESULT_OK;
except on e : Exception do
begin
C.MFinder.SetToleranceSpeed(nCTS);
result := RESULT_OK;
set_last_error(e.message);
result := RESULT_ERROR;
end;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
function get_tolerance_speed(C: TClient; out cts: Integer): Integer; cdecl;
begin
try
begin
cts := C.MFinder.GetToleranceSpeed;
result := RESULT_OK;
try
cts := C.MFinder.GetToleranceSpeed;
result := RESULT_OK;
except on e: Exception do
begin;
set_last_error(e.message);
result := RESULT_ERROR;
end
except on e: Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
function set_tolerance_speed_2_modifiers(C: TClient;
nHue, nSat: Extended): Integer; cdecl;
begin
try
begin
C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat);
result := RESULT_OK;
try
C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat);
result := RESULT_OK;
except on e : Exception do
begin;
set_last_error(e.message);
result := RESULT_ERROR;
end;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
end;
function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended;
@ -511,17 +541,16 @@ function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended;
var
h, s: Extended;
begin
try:
begin
C.MFinder.GetToleranceSpeed2Modifiers(h, s);
hueMod := h;
satMod := s;
result := RESULT_OK;
try
C.MFinder.GetToleranceSpeed2Modifiers(h, s);
hueMod := h;
satMod := s;
result := RESULT_OK;
except on e : Exception do
begin;
set_last_error(e.message);
result := RESULT_ERROR;
end;
except on e : Exception do
begin
set_last_error(e.message);
result := RESULT_ERROR;
end;
end;
@ -530,120 +559,129 @@ end;
{ FIXME: DTM has not been tested yet! }
{ Create a MDTM}
function create_dtm(PointLen: integer; Points: PMDTMPoint; DTM: TMDTM): integer; cdecl;
function create_dtm(PointLen: integer; Points: PMDTMPoint; DTM: TMDTM): integer;
cdecl;
var
i: integer;
begin
DTM := TMDTM.Create;
for i := 0 to PointLen - 1 do
DTM.AddPoint(Points[i]);
if DTM.Valid then
exit(RESULT_OK);
DTM.Free;
set_last_error('Invalid DTM');
result := RESULT_ERROR;
DTM := TMDTM.Create;
for i := 0 to PointLen - 1 do
DTM.AddPoint(Points[i]);
if DTM.Valid then
exit(RESULT_OK);
DTM.Free;
set_last_error('Invalid DTM');
result := RESULT_ERROR;
end;
{ Delete a MDTM. Don't delete it if it is managed! use remove_dtm instead }
function delete_dtm(C: TClient; DTM: TMDTM): integer; cdecl;
begin
if not assigned(DTM) then
begin
set_last_error('DTM is NULL');
exit(RESULT_ERROR);
end;
DTM.Free;
result := RESULT_OK;
if not assigned(DTM) then
begin
set_last_error('DTM is NULL');
exit(RESULT_ERROR);
end;
DTM.Free;
result := RESULT_OK;
end;
{ Add a previously created DTM to the DTM Manager }
function add_dtm(C: TClient; DTM: TMDTM; var index: integer): integer; cdecl;
begin
if not assigned(DTM) then
begin
set_last_error('DTM is NULL');
exit(RESULT_ERROR);
end;
try:
begin
index := C.MDTMs.AddDTM(DTM);
exit(RESULT_OK);
end;
except on e : Exception do
begin
exit(RESULT_ERROR);
end;
if not assigned(DTM) then
begin
set_last_error('DTM is NULL');
exit(RESULT_ERROR);
end;
try
index := C.MDTMs.AddDTM(DTM);
exit(RESULT_OK);
except on e : Exception do
result := RESULT_ERROR;
end;
end;
{ Remove a previously added DTM from the DTM manager. This also frees the DTM }
function remove_dtm(C: TClient; DTMi: integer): integer; cdecl;
begin
C.MDTMs.FreeDTM(DTMi);
C.MDTMs.FreeDTM(DTMi);
end;
{ Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. }
function find_dtm(C: TClient; DTMi: integer; var x, y: integer; x1, y1, x2, y2: integer): integer; cdecl;
function find_dtm(C: TClient; DTMi: integer; var x, y: integer; x1, y1, x2,
y2: integer): integer; cdecl;
var
res: boolean;
begin
try
res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2);
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
try
res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2);
except on e : Exception do
begin;
result := RESULT_ERROR;
set_last_error(e.Message);
end;
end;
if res then
result := RESULT_OK
else
result := RESULT_FALSE;
end;
if res then
result := RESULT_OK
else
result := RESULT_FALSE;
end;
{ Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. }
function find_dtms(C: TClient; DTMi: integer; ptr: PPoint; x1, y1, x2, y2: integer): integer; cdecl;
function find_dtms(C: TClient; DTMi: integer; ptr: PPoint; x1, y1, x2,
y2: integer): integer; cdecl;
var
res: boolean;
len: integer;
TPA: TPointArray;
begin
try
res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2);
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
try
res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2);
except on e : Exception do
begin;
result := RESULT_ERROR;
set_last_error(e.Message);
end;
end;
end;
len := Length(TPA);
if len > 0 then
result := RESULT_OK
else
setlength(tpa, 0);
exit(RESULT_FALSE);
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0);
len := Length(TPA);
if len > 0 then
result := RESULT_OK
else
begin
setlength(tpa, 0);
exit(RESULT_FALSE);
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0);
end;
function set_array_target(C: TClient; Arr: PRGB32; Size: TPoint): integer; cdecl;
function set_array_target(C: TClient; Arr: PRGB32; Size: TPoint): integer;
cdecl;
begin
if not assigned(Arr) then
begin
set_last_error('Arr is not assigned');
exit(RESULT_FALSE);
end;
// FIXME: Catch exceptions.
C.IOManager.SetTarget(Arr, Size);
result := RESULT_OK;
if not assigned(Arr) then
begin
set_last_error('Arr is not assigned');
exit(RESULT_FALSE);
end;
try
C.IOManager.SetTarget(Arr, Size);
result := RESULT_OK;
except on e : Exception do
begin;
set_last_error(e.message);
result := RESULT_FALSE;
end;
end;
end;
exports