moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-24 02:02:17 -05:00
Code Issues Releases Wiki Activity

libMML: Changed the indentation.

Browse Source
This commit is contained in:
Merlijn Wajer 2011-07-17 19:51:16 +02:00
parent 62ee91ab89
commit 851c5a8b36
1 changed files with 356 additions and 353 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

709
Projects/libmml/libmml.lpr
View File

@ -15,6 +15,11 @@ Const
MOUSE_UP = 0; MOUSE_UP = 0;
MOUSE_DOWN = 1; MOUSE_DOWN = 1;
{
Global variables.
To actually read the last_error, make sure you copy it to a safe place
directly after the function call.
}
var var
last_error: String; last_error: String;
debug: boolean; debug: boolean;
@ -23,28 +28,28 @@ var
function init: integer; cdecl; function init: integer; cdecl;
begin begin
last_error := ''; last_error := '';
debug := true; debug := true;
result := RESULT_OK; result := RESULT_OK;
end; end;
procedure set_last_error(s: string); procedure set_last_error(s: string);
begin begin
last_error := s; last_error := s;
if debug then if debug then
writeln('ERROR: ' + s); writeln('ERROR: ' + s);
end; end;
{ Validate the TClient. If it is NULL, set last error and return false } { Validate the TClient. If it is NULL, set last error and return false }
function validate_client(C: TClient): boolean; inline; function validate_client(C: TClient): boolean; inline;
begin begin
result := Assigned(C); result := Assigned(C);
if not result then if not result then
begin begin
last_error := 'PClient is NULL'; last_error := 'PClient is NULL';
if debug then if debug then
writeln(last_error); writeln(last_error);
end; end;
end; end;
{ {
@ -55,42 +60,42 @@ function create_client: PtrUInt; cdecl;
var var
C: TClient; C: TClient;
begin begin
try try
C := TClient.Create(''); C := TClient.Create('');
Result := PtrUInt(C); Result := PtrUInt(C);
except on e : Exception do except on e : Exception do
begin begin
// FIXME UINT negative // FIXME UINT negative
result := PtrUInt(RESULT_ERROR); result := PtrUInt(RESULT_ERROR);
set_last_error(e.message); set_last_error(e.message);
end; end;
end; end;
writeln(format('C: %d, IOManager: %d', [PtrUInt(C), PtrUInt(C.IOManager)])); writeln(format('C: %d, IOManager: %d', [PtrUInt(C), PtrUInt(C.IOManager)]));
end; end;
{ Destroy a TClient } { Destroy a TClient }
function destroy_client(C: TClient): integer; cdecl; function destroy_client(C: TClient): integer; cdecl;
begin begin
try try
C.Free; C.Free;
except on e : Exception do except on e : Exception do
begin begin
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.message); set_last_error(e.message);
end; end;
end; end;
end; end;
{ Set (verbose) debug on/off } { Set (verbose) debug on/off }
procedure set_debug(v: Boolean); cdecl; procedure set_debug(v: Boolean); cdecl;
begin begin
debug := v; debug := v;
end; end;
{ Get debug } { Get debug }
function get_debug: boolean; cdecl; function get_debug: boolean; cdecl;
begin begin
exit(debug); exit(debug);
end; end;
{ {
@ -101,40 +106,40 @@ end;
} }
function get_last_error: pchar; cdecl; function get_last_error: pchar; cdecl;
begin begin
exit(@last_error[1]); exit(@last_error[1]);
end; end;
{ Turn an array into a pointer. The pointer memory is not managed by FPC, so we can pass { Turn an array into a pointer. The pointer memory is not managed by FPC, so we can pass
it along happily. It'll have to be freed by the external control though } it along happily. It'll have to be freed by the external control though }
function array_to_ptr(ptr: Pointer; size: PtrUInt; objsize: PtrUInt): Pointer; cdecl; function array_to_ptr(ptr: Pointer; size: PtrUInt; objsize: PtrUInt): Pointer; cdecl;
begin begin
result := GetMem(objsize * size); result := GetMem(objsize * size);
Move(ptr^, result^, objsize * size); Move(ptr^, result^, objsize * size);
end; end;
{ Free memory previously allocated by libMML } { Free memory previously allocated by libMML }
function free_ptr(ptr: pointer): boolean; cdecl; function free_ptr(ptr: pointer): boolean; cdecl;
begin begin
result := Assigned(ptr); result := Assigned(ptr);
if not result then if not result then
begin begin
set_last_error('TClient is NULL'); set_last_error('TClient is NULL');
if debug then if debug then
writeln(last_error); writeln(last_error);
end else end else
FreeMem(ptr); FreeMem(ptr);
end; end;
{ Allocate memory with libMML } { Allocate memory with libMML }
function alloc_mem(size, objsize: PtrUInt): Pointer; cdecl; function alloc_mem(size, objsize: PtrUInt): Pointer; cdecl;
begin begin
result := GetMem(size * objsize); result := GetMem(size * objsize);
end; end;
{ Reallocate memory with libMML } { Reallocate memory with libMML }
function realloc_mem(ptr: Pointer; size, objsize: PtrUInt): Pointer; cdecl; function realloc_mem(ptr: Pointer; size, objsize: PtrUInt): Pointer; cdecl;
begin begin
result := ReAllocMem(ptr, size*objsize); result := ReAllocMem(ptr, size*objsize);
end; end;
{ Mouse } { Mouse }
@ -143,34 +148,32 @@ end;
function get_mouse_pos(C: TClient; var t: tpoint): integer; cdecl; function get_mouse_pos(C: TClient; var t: tpoint): integer; cdecl;
begin begin
if not validate_client(C) then if not validate_client(C) then
exit(RESULT_ERROR);
try
C.IOManager.GetMousePos(t.x,t.y);
result := RESULT_OK;
except on e : Exception do
begin begin
exit(RESULT_ERROR); result := RESULT_ERROR;
end; set_last_error(e.Message);
try
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;
end;
end; end;
{ Set mouse position of client C to point t } { Set mouse position of client C to point t }
function set_mouse_pos(C: TClient; var t: tpoint): integer; cdecl; function set_mouse_pos(C: TClient; var t: tpoint): integer; cdecl;
begin begin
try try
C.IOManager.MoveMouse(t.x,t.y); C.IOManager.MoveMouse(t.x,t.y);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin begin
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end; end;
end; end;
end; end;
@ -187,38 +190,38 @@ end;
{ Return the state of a mouse button given client C } { Return the state of a mouse button given client C }
function get_mouse_button_state(C: TClient; But: Integer): Integer; cdecl; function get_mouse_button_state(C: TClient; But: Integer): Integer; cdecl;
begin begin
try try
if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then if C.IOManager.IsMouseButtonDown(ConvIntClickType(But)) then
result := MOUSE_DOWN result := MOUSE_DOWN
else else
result := MOUSE_UP; result := MOUSE_UP;
except on e : Exception do except on e : Exception do
begin begin
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end;
end; end;
end;
end; end;
{ Set the state of a mouse button given client C } { Set the state of a mouse button given client C }
function set_mouse_button_state(C: TClient; But, State, X, Y: Integer): Integer; cdecl; function set_mouse_button_state(C: TClient; But, State, X, Y: Integer): Integer; cdecl;
begin begin
try try
if State = MOUSE_UP then if State = MOUSE_UP then
begin
C.IOManager.ReleaseMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end else if state = MOUSE_DOWN then
begin
C.IOManager.HoldMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end;
except on e : Exception do
begin begin
result := RESULT_ERROR; C.IOManager.ReleaseMouse(X, Y, ConvIntClickType(But));
set_last_error(e.Message); result := RESULT_OK;
end else if state = MOUSE_DOWN then
begin
C.IOManager.HoldMouse(X, Y, ConvIntClickType(But));
result := RESULT_OK;
end; end;
except on e : Exception do
begin
result := RESULT_ERROR;
set_last_error(e.Message);
end; end;
end;
end; end;
@ -227,52 +230,52 @@ end;
function get_color(C: TClient; x, y: Integer; function get_color(C: TClient; x, y: Integer;
out color: Integer): Integer; cdecl; out color: Integer): Integer; cdecl;
begin begin
try try
color := C.IOManager.GetColor(x, y); color := C.IOManager.GetColor(x, y);
if color > -1 then if color > -1 then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
{ Find color on client C in area (x1,y1,x2,y2) and return coordinate (if any) in x, y } { Find color on client C in area (x1,y1,x2,y2) and return coordinate (if any) in x, y }
function find_color(C: TClient; var x, y: Integer; function find_color(C: TClient; var x, y: Integer;
color, x1, y1, x2, y2: Integer): Integer; cdecl; color, x1, y1, x2, y2: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColor(x, y, color, x1, y1, x2, y2) then if C.MFinder.FindColor(x, y, color, x1, y1, x2, y2) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_color_tolerance(C: TClient; var x, y: Integer; color: Integer; function find_color_tolerance(C: TClient; var x, y: Integer; color: Integer;
tol, x1, y1, x2, y2: Integer): Integer; cdecl; tol, x1, y1, x2, y2: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol) then if C.MFinder.FindColorTolerance(x, y, color, x1, y1, x2, y2, tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_color_tolerance_optimised(C: TClient; var x, y: Integer; function find_color_tolerance_optimised(C: TClient; var x, y: Integer;
@ -280,18 +283,18 @@ function find_color_tolerance_optimised(C: TClient; var x, y: Integer;
x1, y1, x2, y2: Integer; x1, y1, x2, y2: Integer;
tol: Integer): Integer; cdecl; tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorToleranceOptimised(x, y, col, x1, y1, x2, y2, if C.MFinder.FindColorToleranceOptimised(x, y, col, x1, y1, x2, y2,
tol) then tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_colors(C: TClient; var ptr: PPoint; var len: Integer; function find_colors(C: TClient; var ptr: PPoint; var len: Integer;
@ -299,27 +302,27 @@ function find_colors(C: TClient; var ptr: PPoint; var len: Integer;
var var
TPA: TPointArray; TPA: TPointArray;
begin begin
setlength(TPA, 0); setlength(TPA, 0);
try try
C.MFinder.FindColors(TPA, color, x1, y1, x2, y2); C.MFinder.FindColors(TPA, color, x1, y1, x2, y2);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; result := RESULT_ERROR;
end; end;
end; end;
len := Length(TPA); len := Length(TPA);
if len > 0 then if len > 0 then
result := RESULT_OK result := RESULT_OK
else else
begin begin
setlength(tpa, 0);
exit(RESULT_FALSE);
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(tpa, 0); setlength(tpa, 0);
exit(RESULT_FALSE);
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(tpa, 0);
end; end;
function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer; function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer;
@ -327,26 +330,26 @@ function find_colors_tolerance(C: TClient; var ptr: PPoint; var len: Integer;
var var
TPA: TPointArray; TPA: TPointArray;
begin begin
try try
C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol); C.MFinder.FindColorsTolerance(TPA, color, x1, y1, x2, y2, tol);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.Message); set_last_error(e.Message);
result := RESULT_ERROR; 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;
end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); len := Length(TPA);
setlength(TPA, 0); 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; end;
function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint; function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint;
@ -356,184 +359,184 @@ function find_colors_tolerance_optimised(C: TClient; var ptr: PPoint;
var var
TPA: TPointArray; TPA: TPointArray;
begin begin
try try
C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol); C.MFinder.FindColorsToleranceOptimised(TPA, col, x1, y1, x2, y2, tol);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end; end;
end; end;
len := Length(TPA); len := Length(TPA);
if len > 0 then if len > 0 then
result := RESULT_OK result := RESULT_OK
else else
begin begin
setlength(tpa, 0); setlength(tpa, 0);
exit(RESULT_FALSE); exit(RESULT_FALSE);
end; end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0); setlength(TPA, 0);
end; end;
function similar_colors(C: TClient; col1, col2, tol: Integer): Integer; cdecl; function similar_colors(C: TClient; col1, col2, tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.SimilarColors(col1, col2, tol) then if C.MFinder.SimilarColors(col1, col2, tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_FALSE; result := RESULT_FALSE;
end;
end; end;
end;
end; end;
function count_color(C: TClient; out count: Integer; function count_color(C: TClient; out count: Integer;
Color, xs, ys, xe, ye: Integer): Integer; cdecl; Color, xs, ys, xe, ye: Integer): Integer; cdecl;
begin begin
try try
count := C.MFinder.CountColor(Color, xs, ys, xe, ye); count := C.MFinder.CountColor(Color, xs, ys, xe, ye);
if count > 0 then if count > 0 then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function count_color_tolerance(C: TClient; out count: Integer; col: Integer; function count_color_tolerance(C: TClient; out count: Integer; col: Integer;
xs, ys, xe, ye, tol: Integer): Integer; cdecl; xs, ys, xe, ye, tol: Integer): Integer; cdecl;
begin begin
try try
count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol); count := C.MFinder.CountColorTolerance(col, xs, ys, xe, ye, tol);
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
if count > 0 then if count > 0 then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
end; end;
function find_color_spiral(C: TClient; var x, y: Integer; function find_color_spiral(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye: Integer): Integer; cdecl; col, xs, ys, xe, ye: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then if C.MFinder.FindColorSpiral(x, y, col, xs, ys, xe, ye) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_color_spiral_tolerance(C: TClient; var x, y: Integer; function find_color_spiral_tolerance(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye: Integer; col, xs, ys, xe, ye: Integer;
tol: Integer): Integer; cdecl; tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye, if C.MFinder.FindColorSpiralTolerance(x, y, col, xs, ys, xe, ye,
tol) then tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_colored_area(C: TClient; var x, y: Integer; function find_colored_area(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye, minA: Integer): Integer; cdecl; col, xs, ys, xe, ye, minA: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then if C.MFinder.FindColoredArea(x, y, col, xs, ys, xe, ye, minA) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function find_colored_area_tolerance(C: TClient; var x, y: Integer; function find_colored_area_tolerance(C: TClient; var x, y: Integer;
col, xs, ys, xe, ye, minA: Integer; col, xs, ys, xe, ye, minA: Integer;
tol: Integer): Integer; cdecl; tol: Integer): Integer; cdecl;
begin begin
try try
if C.MFinder.FindColoredAreaTolerance(x, y, col, if C.MFinder.FindColoredAreaTolerance(x, y, col,
xs, ys, xe, ye, minA, tol) then xs, ys, xe, ye, minA, tol) then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function set_tolerance_speed(C: TClient; nCTS: Integer): Integer; cdecl; function set_tolerance_speed(C: TClient; nCTS: Integer): Integer; cdecl;
begin begin
try try
C.MFinder.SetToleranceSpeed(nCTS); C.MFinder.SetToleranceSpeed(nCTS);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function get_tolerance_speed(C: TClient; out cts: Integer): Integer; cdecl; function get_tolerance_speed(C: TClient; out cts: Integer): Integer; cdecl;
begin begin
try try
cts := C.MFinder.GetToleranceSpeed; cts := C.MFinder.GetToleranceSpeed;
result := RESULT_OK; result := RESULT_OK;
except on e: Exception do except on e: Exception do
begin; begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end end
end; end;
end; end;
function set_tolerance_speed_2_modifiers(C: TClient; function set_tolerance_speed_2_modifiers(C: TClient;
nHue, nSat: Extended): Integer; cdecl; nHue, nSat: Extended): Integer; cdecl;
begin begin
try try
C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat); C.MFinder.SetToleranceSpeed2Modifiers(nHue, nSat);
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin; begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended; function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended;
@ -541,17 +544,17 @@ function get_tolerance_speed_2_modifiers(C: TClient; out hueMod: Extended;
var var
h, s: Extended; h, s: Extended;
begin begin
try try
C.MFinder.GetToleranceSpeed2Modifiers(h, s); C.MFinder.GetToleranceSpeed2Modifiers(h, s);
hueMod := h; hueMod := h;
satMod := s; satMod := s;
result := RESULT_OK; result := RESULT_OK;
except on e : Exception do except on e : Exception do
begin; begin
set_last_error(e.message); set_last_error(e.message);
result := RESULT_ERROR; result := RESULT_ERROR;
end;
end; end;
end;
end; end;
{ DTM } { DTM }
@ -564,53 +567,53 @@ function create_dtm(PointLen: integer; Points: PMDTMPoint; DTM: TMDTM): integer;
var var
i: integer; i: integer;
begin begin
DTM := TMDTM.Create; DTM := TMDTM.Create;
for i := 0 to PointLen - 1 do for i := 0 to PointLen - 1 do
DTM.AddPoint(Points[i]); DTM.AddPoint(Points[i]);
if DTM.Valid then if DTM.Valid then
exit(RESULT_OK); exit(RESULT_OK);
DTM.Free; DTM.Free;
set_last_error('Invalid DTM'); set_last_error('Invalid DTM');
result := RESULT_ERROR; result := RESULT_ERROR;
end; end;
{ Delete a MDTM. Don't delete it if it is managed! use remove_dtm instead } { Delete a MDTM. Don't delete it if it is managed! use remove_dtm instead }
function delete_dtm(C: TClient; DTM: TMDTM): integer; cdecl; function delete_dtm(C: TClient; DTM: TMDTM): integer; cdecl;
begin begin
if not assigned(DTM) then if not assigned(DTM) then
begin begin
set_last_error('DTM is NULL'); set_last_error('DTM is NULL');
exit(RESULT_ERROR); exit(RESULT_ERROR);
end; end;
DTM.Free; DTM.Free;
result := RESULT_OK; result := RESULT_OK;
end; end;
{ Add a previously created DTM to the DTM Manager } { Add a previously created DTM to the DTM Manager }
function add_dtm(C: TClient; DTM: TMDTM; var index: integer): integer; cdecl; function add_dtm(C: TClient; DTM: TMDTM; var index: integer): integer; cdecl;
begin begin
if not assigned(DTM) then if not assigned(DTM) then
begin begin
set_last_error('DTM is NULL'); set_last_error('DTM is NULL');
exit(RESULT_ERROR); exit(RESULT_ERROR);
end; end;
try try
index := C.MDTMs.AddDTM(DTM); index := C.MDTMs.AddDTM(DTM);
exit(RESULT_OK); exit(RESULT_OK);
except on e : Exception do except on e : Exception do
result := RESULT_ERROR; result := RESULT_ERROR;
end; end;
end; end;
{ Remove a previously added DTM from the DTM manager. This also frees the DTM } { Remove a previously added DTM from the DTM manager. This also frees the DTM }
function remove_dtm(C: TClient; DTMi: integer): integer; cdecl; function remove_dtm(C: TClient; DTMi: integer): integer; cdecl;
begin begin
C.MDTMs.FreeDTM(DTMi); C.MDTMs.FreeDTM(DTMi);
end; end;
{ Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. } { Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. }
@ -619,19 +622,19 @@ function find_dtm(C: TClient; DTMi: integer; var x, y: integer; x1, y1, x2,
var var
res: boolean; res: boolean;
begin begin
try try
res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2); res := C.MFinder.FindDTM(C.MDTMs.DTM[DTMi], x, y, x1, y1, x2, y2);
except on e : Exception do except on e : Exception do
begin; begin;
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end; end;
end; end;
if res then if res then
result := RESULT_OK result := RESULT_OK
else else
result := RESULT_FALSE; result := RESULT_FALSE;
end; end;
{ Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. } { Find a DTM given DTM index i, client C in area x1,y1,x2,y2. Return coord at x, y. }
@ -642,46 +645,46 @@ var
len: integer; len: integer;
TPA: TPointArray; TPA: TPointArray;
begin begin
try try
res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2); res := C.MFinder.FindDTMs(C.MDTMs.DTM[DTMi], TPA, x1, y1, x2, y2);
except on e : Exception do except on e : Exception do
begin; begin;
result := RESULT_ERROR; result := RESULT_ERROR;
set_last_error(e.Message); set_last_error(e.Message);
end; end;
end; end;
len := Length(TPA); len := Length(TPA);
if len > 0 then if len > 0 then
result := RESULT_OK result := RESULT_OK
else else
begin begin
setlength(tpa, 0); setlength(tpa, 0);
exit(RESULT_FALSE); exit(RESULT_FALSE);
end; end;
ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint)); ptr := array_to_ptr(Pointer(@TPA[0]), len, sizeof(TPoint));
setlength(TPA, 0); setlength(TPA, 0);
end; end;
function set_array_target(C: TClient; Arr: PRGB32; Size: TPoint): integer; function set_array_target(C: TClient; Arr: PRGB32; Size: TPoint): integer;
cdecl; cdecl;
begin begin
if not assigned(Arr) then 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 begin
set_last_error('Arr is not assigned'); set_last_error(e.message);
exit(RESULT_FALSE); result := 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;
end;
end; end;
exports exports