mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-22 01:02:17 -05:00
Fixed.
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@99 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Raymond
parent
0f2c4af46f
commit
33b416a939
@ -1,67 +1,67 @@
|
||||
|
||||
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
|
||||
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
|
||||
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
||||
|
||||
//Sender.Comp.AddTypeS('pDTM','pDTM = record p: TPointArray; c, t, asz, ash: TIntegerArray; end');
|
||||
|
||||
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
|
||||
|
||||
{ DTM }
|
||||
|
||||
Sender.AddFunction(@ps_StringFromDTM, 'function StringFromDTM(DTMString: String): Integer;');
|
||||
Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
|
||||
Sender.AddFunction(@FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
|
||||
|
||||
|
||||
{maths}
|
||||
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
|
||||
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
|
||||
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
|
||||
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
|
||||
|
||||
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
|
||||
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
|
||||
|
||||
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
|
||||
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
|
||||
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
|
||||
Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
|
||||
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
|
||||
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
|
||||
Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
|
||||
|
||||
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
||||
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
|
||||
|
||||
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
|
||||
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
|
||||
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
|
||||
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
|
||||
|
||||
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
|
||||
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
|
||||
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
|
||||
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
|
||||
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
|
||||
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
|
||||
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
|
||||
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
|
||||
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
|
||||
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
|
||||
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
|
||||
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
|
||||
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
|
||||
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
|
||||
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
|
||||
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
|
||||
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
|
||||
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer');
|
||||
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
|
||||
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
|
||||
|
||||
//Sender.Comp.AddTypeS('pDTM','pDTM = record p: TPointArray; c, t, asz, ash: TIntegerArray; end');
|
||||
|
||||
Sender.AddFunction(@ThreadSafeCall,'function ThreadSafeCall(ProcName: string; var V: TVariantArray): Variant;');
|
||||
Sender.AddFunction(@psWriteln,'procedure writeln(s : string);');
|
||||
|
||||
{ DTM }
|
||||
|
||||
Sender.AddFunction(@ps_StringFromDTM, 'function DTMFromString(DTMString: String): Integer;');
|
||||
Sender.AddFunction(@ps_FreeDTM, 'procedure FreeDTM(DTM: Integer);');
|
||||
Sender.AddFunction(@FindDTM, 'function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;');
|
||||
|
||||
|
||||
{maths}
|
||||
sender.AddFunction(@power,'function pow(base,exponent : extended) : extended');
|
||||
Sender.AddFunction(@max,'function Max(a, b: Integer): Integer;');
|
||||
Sender.AddFunction(@min,'function Min(a, b: Integer): Integer;');
|
||||
Sender.AddFunction(@pssqr,'function Sqr(e : extended) : extended;');
|
||||
|
||||
Sender.AddFunction(@Freeze, 'function freeze:boolean;');
|
||||
Sender.AddFunction(@Unfreeze, 'function unfreeze: boolean;');
|
||||
|
||||
Sender.AddFunction(@GetColor,'function GetColor(x, y: Integer): Integer;');
|
||||
Sender.AddFunction(@FindColor, 'function findcolor(var x, y: integer; color, x1, y1, x2, y2: integer): boolean;');
|
||||
Sender.AddFunction(@FindColorTolerance, 'function findcolortolerance(var x, y: integer; color, x1, y1, x2, y2, tol: integer): boolean;');
|
||||
Sender.AddFunction(@FindColors, 'function findcolors(var TPA: TPointArray; color, x1, y1, x2, y2: integer): boolean;');
|
||||
Sender.AddFunction(@SimilarColors,'function SimilarColors(Col1,Col2,Tolerance : integer) : boolean');
|
||||
Sender.AddFunction(@CountColorTolerance,'function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;');
|
||||
Sender.AddFunction(@FindColorsTolerance,'function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tolerance: Integer): Boolean;');
|
||||
|
||||
Sender.AddFunction(@MoveMouse, 'procedure MoveMouse(x, y: integer);');
|
||||
Sender.AddFunction(@GetMousePos, 'procedure GetMousePos(var x, y: integer);');
|
||||
|
||||
Sender.AddFunction(@Wait, 'procedure wait(t: integer);');
|
||||
Sender.AddFunction(@GetClientDimensions, 'procedure GetClientDimensions(var w, h:integer);');
|
||||
Sender.AddFunction(@SetColorToleranceSpeed, 'procedure SetColorToleranceSpeed(cts: integer);');
|
||||
Sender.AddFunction(@GetTickCount, 'function GetSystemTime: Integer;');
|
||||
|
||||
Sender.AddFunction(@CreateBitmap,'function CreateBitmap(w,h :integer) : integer;');
|
||||
Sender.AddFunction(@FreeBitmap,'procedure FreeBitmap(Bmp : integer);');
|
||||
Sender.AddFunction(@SaveBitmap,'procedure SaveBitmap(Bmp : integer; path : string);');
|
||||
Sender.AddFunction(@BitmapFromString,'function BitmapFromString(Width,Height : integer; Data : string): integer;');
|
||||
Sender.AddFunction(@LoadBitmap,'function LoadBitmap(Path : string) : integer;');
|
||||
Sender.AddFunction(@SetBitmapSize,'procedure SetBitmapSize(Bmp,NewW,NewH : integer);');
|
||||
Sender.AddFunction(@GetBitmapSize,'procedure GetBitmapSize(Bmp : integer; Var BmpW,BmpH : integer);');
|
||||
Sender.AddFunction(@CreateMirroredBitmap,'function CreateMirroredBitmap(Bmp : integer) : integer;');
|
||||
Sender.AddFunction(@CreateMirroredBitmapEx,'function CreateMirroredBitmapEx(Bmp : integer; MirrorStyle : TBmpMirrorStyle) : integer;');
|
||||
Sender.AddFunction(@FastSetPixel,'procedure FastSetPixel(bmp,x,y : integer; Color : TColor);');
|
||||
Sender.AddFunction(@FastSetPixels,'procedure FastSetPixels(bmp : integer; TPA : TPointArray; Colors : TIntegerArray);');
|
||||
Sender.AddFunction(@FastGetPixel,'function FastGetPixel(bmp, x,y : integer) : TColor;');
|
||||
Sender.AddFunction(@FastGetPixels,'function FastGetPixels(Bmp : integer; TPA : TPointArray) : TIntegerArray;');
|
||||
Sender.AddFunction(@FastDrawClear,'procedure FastDrawClear(bmp : integer; Color : TColor)');
|
||||
Sender.AddFunction(@FastDrawTransparent,'procedure FastDrawTransparent(x, y: Integer; SourceBitmap, TargetBitmap: Integer);');
|
||||
Sender.AddFunction(@SetTransparentColor,'procedure SetTransparentColor(bmp : integer; Color : TColor);');
|
||||
Sender.AddFunction(@GetTransparentColor,'function GetTransparentColor(bmp: integer) : TColor;');
|
||||
Sender.AddFunction(@FastReplaceColor,'procedure FastReplaceColor(Bmp : integer; OldColor,NewColor : TColor);');
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -34,7 +34,7 @@ begin
|
||||
MFiles := TMFiles.Create;
|
||||
MFinder := TMFinder.Create(Self);
|
||||
MBitmaps := TMBitmaps.Create(self);
|
||||
MDTM := MDTM.Create(self);
|
||||
MDTM := TMDTM.Create(self);
|
||||
end;
|
||||
|
||||
destructor TClient.Destroy;
|
||||
|
||||
@ -1,322 +1,322 @@
|
||||
unit dtm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, MufasaTypes;
|
||||
|
||||
type
|
||||
TMDTM = class(TObject)
|
||||
constructor Create(Owner: TObject);
|
||||
destructor Destroy; override;
|
||||
|
||||
function AddDTM(d: TDTM): Integer;
|
||||
function AddpDTM(d: pDTM): Integer;
|
||||
function GetDTM(index: Integer; var dtm: pDTM): Boolean;
|
||||
procedure FreeDTM(DTM: Integer);
|
||||
Function StringToDTM(S: String): pDTM;
|
||||
|
||||
function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2,
|
||||
y2: Integer): Boolean;
|
||||
{ function FindDTMs(DTM: Integer; var Points: TPointArray; x1, y1, x2,
|
||||
y2: Integer): Boolean;
|
||||
function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2,
|
||||
y2: Integer; sAngle, eAngle, aStep: Extended;
|
||||
var aFound: Extended): Boolean;
|
||||
function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1,
|
||||
y1, x2, y2: Integer; sAngle, eAngle,
|
||||
aStep: Extended; var aFound: T2DExtendedArray)
|
||||
: Boolean; }
|
||||
function pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2:
|
||||
Integer): Boolean;
|
||||
|
||||
private
|
||||
|
||||
Client: TObject;
|
||||
|
||||
// For decompressing.
|
||||
BufferString: String;
|
||||
|
||||
DTMList: Array Of pDTM;
|
||||
FreeSpots: Array Of Integer;
|
||||
end;
|
||||
const
|
||||
dtm_Rectangle = 0;
|
||||
dtm_Cross = 1;
|
||||
dtm_DiagonalCross = 2;
|
||||
dtm_Circle = 3;
|
||||
dtm_Triangle = 4;
|
||||
|
||||
{
|
||||
I am not sure wether I should simply copy and paste the old DTM implementation,
|
||||
or rewrite it from scratch.
|
||||
|
||||
I recall there was something partially wrong with SCAR-alike DTM conversions
|
||||
to Mufasa DTM's...
|
||||
|
||||
The old DTM system problaby doesn't perform that well, but seems to be quite
|
||||
stable and complete.
|
||||
|
||||
If I would rewrite it from scratch, it would probably be faster, and
|
||||
hopefully more efficient.That won't be too hard, especially since I have
|
||||
direct data access now. (TClient FTW!)
|
||||
|
||||
Rewrite from scratch it will be, I guess.
|
||||
And AreaShape will be turned into a {$I }, inline simply doesn't cut it.
|
||||
|
||||
~Wizz
|
||||
}
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
Client, dtmutil, paszlib;
|
||||
|
||||
type
|
||||
TBufferByteArray = Array[0..524288] of Byte;
|
||||
PBufferByteArray = ^TBufferByteArray;
|
||||
|
||||
constructor TMDTM.Create(Owner: TObject);
|
||||
begin
|
||||
inherited Create;
|
||||
Self.Client := Owner;
|
||||
|
||||
SetLength(DTMList, 0);
|
||||
SetLength(FreeSpots, 0);
|
||||
SetLength(BufferString, 524288);
|
||||
end;
|
||||
|
||||
destructor TMDTM.Destroy;
|
||||
|
||||
begin
|
||||
SetLength(DTMList, 0);
|
||||
SetLength(FreeSpots, 0);
|
||||
SetLength(BufferString, 0);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function HexToInt(HexNum: string): LongInt;inline;
|
||||
begin
|
||||
Result:=StrToInt('$' + HexNum);
|
||||
end;
|
||||
|
||||
function TMDTM.StringToDTM(S: String): pDTM;
|
||||
var
|
||||
b: PBufferByteArray;
|
||||
Source : String;
|
||||
DestLen : LongWord;
|
||||
i,ii,c : integer;
|
||||
begin
|
||||
SetLength(Result.p,0);
|
||||
SetLength(Result.c,0);
|
||||
SetLength(Result.t,0);
|
||||
SetLength(Result.asz,0);
|
||||
SetLength(Result.ash,0);
|
||||
ii := Length(S);
|
||||
if (ii = 0) or (ii mod 2 <> 0) then
|
||||
Exit;
|
||||
ii := ii div 2;
|
||||
SetLength(Source,ii);
|
||||
for i := 1 to ii do
|
||||
Source[i] := Chr(HexToInt(S[i * 2 - 1] + S[i * 2]));
|
||||
DestLen := Length(Self.BufferString);
|
||||
if uncompress(PChar(Self.Bufferstring),Destlen,pchar(Source), ii) = Z_OK then
|
||||
begin;
|
||||
if (Destlen mod 36) > 0 then
|
||||
begin;
|
||||
Writeln('Invalid DTM');
|
||||
Exit;
|
||||
end;
|
||||
DestLen := DestLen div 36;
|
||||
SetLength(Result.p,DestLen);
|
||||
SetLength(Result.c,DestLen);
|
||||
SetLength(Result.t,DestLen);
|
||||
SetLength(Result.asz,DestLen);
|
||||
SetLength(Result.ash,DestLen);
|
||||
b := @Self.Bufferstring[1];
|
||||
for i := 0 to DestLen - 1 do
|
||||
begin;
|
||||
c := i * 36;
|
||||
Result.p[i].x := PInteger(@b^[c+1])^;
|
||||
Result.p[i].y := PInteger(@b^[c+5])^;
|
||||
Result.asz[i] := PInteger(@b^[c+12])^;
|
||||
Result.ash[i] := PInteger(@b^[c+16])^;
|
||||
Result.c[i] := PInteger(@b^[c+20])^;
|
||||
Result.t[i] := PInteger(@b^[c+24])^;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMDTM.AddDTM(d: TDTM): Integer;
|
||||
|
||||
begin
|
||||
if Length(FreeSpots) > 0 then
|
||||
begin
|
||||
DTMList[FreeSpots[High(FreeSpots)]] := TDTMTopDTM(d);
|
||||
Result := FreeSpots[High(FreeSpots)];
|
||||
SetLength(FreeSpots, High(FreeSpots));
|
||||
end
|
||||
else
|
||||
begin
|
||||
SetLength(DTMList, Length(DTMList) + 1);
|
||||
DTMList[High(DTMList)] := TDTMTopDTM(d);
|
||||
Result := High(DTMList);
|
||||
end;
|
||||
end;
|
||||
|
||||
{/\
|
||||
Adds the given pDTM to the DTM Array, and returns it's index.
|
||||
/\}
|
||||
|
||||
function TMDTM.AddpDTM(d: pDTM): Integer;
|
||||
|
||||
begin
|
||||
if Length(FreeSpots) > 0 then
|
||||
begin
|
||||
DTMList[FreeSpots[High(FreeSpots)]] := d;
|
||||
Result := FreeSpots[High(FreeSpots)];
|
||||
SetLength(FreeSpots, High(FreeSpots));
|
||||
end
|
||||
Else
|
||||
begin
|
||||
SetLength(DTMList, Length(DTMList) + 1);
|
||||
DTMList[High(DTMList)] := d;
|
||||
Result := High(DTMList);
|
||||
end;
|
||||
end;
|
||||
|
||||
{/\
|
||||
Returns the DTM (pDTM type) in the variable dtm at the given index.
|
||||
Returns true is succesfull, false if the dtm does not exist.
|
||||
/\}
|
||||
|
||||
function TMDTM.GetDTM(index: Integer; var dtm: pDTM): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
try
|
||||
dtm := DTMList[index];
|
||||
except
|
||||
begin
|
||||
raise Exception.CreateFmt('The given DTM Index ([%d]) is invalid.',
|
||||
[index]);
|
||||
//WriteLn('DTM Index ' + IntToStr(index) + ' does not exist');
|
||||
Result := False;
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
{/\
|
||||
Unloads the DTM at the given index from the DTM Array.
|
||||
Notes:
|
||||
Will keep track of not used index, so it is very memory efficient.
|
||||
/\}
|
||||
|
||||
Procedure TMDTM.FreeDTM(DTM: Integer);
|
||||
begin
|
||||
try
|
||||
SetLength(DTMList[DTM].p, 0);
|
||||
SetLength(DTMList[DTM].c, 0);
|
||||
SetLength(DTMList[DTM].t, 0);
|
||||
SetLength(DTMList[DTM].asz, 0);
|
||||
SetLength(DTMList[DTM].ash, 0);
|
||||
except
|
||||
//WriteLn('Invalid DTM');
|
||||
end;
|
||||
SetLength(FreeSpots, Length(FreeSpots) + 1);
|
||||
FreeSpots[High(FreeSpots)] := DTM;
|
||||
end;
|
||||
|
||||
{
|
||||
Tries to find the given DTM (index). If found will put the point the dtm has
|
||||
been found at in x, y and result to true.
|
||||
}
|
||||
function TMDTM.FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
temp: pDTM;
|
||||
begin
|
||||
if GetDTM(DTM, temp) then
|
||||
Result := pFindDTM(temp, x, y, x1, y1, x2, y2)
|
||||
else
|
||||
begin
|
||||
x := 0;
|
||||
y := 0;
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
Tries to find the given pDTM. If found will put the point the dtm has
|
||||
been found at in x, y and result to true.
|
||||
}
|
||||
|
||||
function TMDTM.pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
|
||||
|
||||
var
|
||||
mP: TPointArray;
|
||||
I, J, H, dH: Integer;
|
||||
Found: Boolean;
|
||||
TempTP: TPoint;
|
||||
RetData: TRetData;
|
||||
|
||||
begin
|
||||
for I := 1 to High(DTM.p) do
|
||||
begin
|
||||
DTM.p[I].x := DTM.p[I].x - DTM.p[0].x;
|
||||
DTM.p[I].y := DTM.p[I].y - DTM.p[0].y;
|
||||
end;
|
||||
|
||||
// X2 := X2 - MaxSubPointDist.X
|
||||
// Y2 := Y2 - MaxSubPointDist.Y
|
||||
// X1 := X1 + MaxSubPointDist.X
|
||||
// Y1 := Y1 + MaxSubPointDist.Y
|
||||
// If X2 > X1 then Exit
|
||||
// If Y2 > Y1 then Exit
|
||||
// Will make sure there are no out of bounds exceptions, and will make it faster
|
||||
|
||||
TClient(Client).MWindow.Freeze();
|
||||
|
||||
TClient(Client).MFinder.FindColorsTolerance(mP, DTM.c[Low(DTM.c)],
|
||||
x1, y1, x2, y2, DTM.t[Low(DTM.t)]);
|
||||
|
||||
TClient(Client).MWindow.GetDimensions(H, dH);
|
||||
RetData := TClient(Client).MWindow.ReturnData(0, 0, H, dH);
|
||||
|
||||
H := High(mP);
|
||||
dH := High(DTM.p);
|
||||
for I := 0 to H do
|
||||
begin
|
||||
// Use MainPoint's AreaSize and Shape.
|
||||
// for Loop on mP, depending on the AreaShape. then on all the code beneath
|
||||
// this point, use the var that is retrieved from the for loop.
|
||||
Found := True;
|
||||
for J := 1 to dH do
|
||||
begin
|
||||
TempTP.X := DTM.p[J].X + mP[I].X;
|
||||
TempTP.Y := DTM.p[J].Y + mP[I].Y;
|
||||
//Now would be the time to Rotate TempTP
|
||||
//If Not AreaShape(DTM.c[J], DTM.t[J], DTM.asz[J], DTM.ash[J], TempTP) then
|
||||
if False then
|
||||
begin
|
||||
Found := False;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Found then
|
||||
begin
|
||||
Result := True;
|
||||
x := mP[I].X;
|
||||
y := mP[I].Y;
|
||||
TClient(Client).MWindow.UnFreeze();
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
TClient(Client).MWindow.UnFreeze();
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
unit dtm;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, MufasaTypes;
|
||||
|
||||
type
|
||||
TMDTM = class(TObject)
|
||||
|
||||
function AddDTM(d: TDTM): Integer;
|
||||
function AddpDTM(d: pDTM): Integer;
|
||||
function GetDTM(index: Integer; var dtm: pDTM): Boolean;
|
||||
procedure FreeDTM(DTM: Integer);
|
||||
Function StringToDTM(S: String): pDTM;
|
||||
|
||||
function FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2,
|
||||
y2: Integer): Boolean;
|
||||
{ function FindDTMs(DTM: Integer; var Points: TPointArray; x1, y1, x2,
|
||||
y2: Integer): Boolean;
|
||||
function FindDTMRotated(DTM: Integer; var x, y: Integer; x1, y1, x2,
|
||||
y2: Integer; sAngle, eAngle, aStep: Extended;
|
||||
var aFound: Extended): Boolean;
|
||||
function FindDTMsRotated(DTM: Integer; var Points: TPointArray; x1,
|
||||
y1, x2, y2: Integer; sAngle, eAngle,
|
||||
aStep: Extended; var aFound: T2DExtendedArray)
|
||||
: Boolean; }
|
||||
function pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2:
|
||||
Integer): Boolean;
|
||||
|
||||
constructor Create(Owner: TObject);
|
||||
destructor Destroy; override;
|
||||
private
|
||||
|
||||
Client: TObject;
|
||||
|
||||
// For decompressing.
|
||||
BufferString: String;
|
||||
|
||||
DTMList: Array Of pDTM;
|
||||
FreeSpots: Array Of Integer;
|
||||
end;
|
||||
const
|
||||
dtm_Rectangle = 0;
|
||||
dtm_Cross = 1;
|
||||
dtm_DiagonalCross = 2;
|
||||
dtm_Circle = 3;
|
||||
dtm_Triangle = 4;
|
||||
|
||||
{
|
||||
I am not sure wether I should simply copy and paste the old DTM implementation,
|
||||
or rewrite it from scratch.
|
||||
|
||||
I recall there was something partially wrong with SCAR-alike DTM conversions
|
||||
to Mufasa DTM's...
|
||||
|
||||
The old DTM system problaby doesn't perform that well, but seems to be quite
|
||||
stable and complete.
|
||||
|
||||
If I would rewrite it from scratch, it would probably be faster, and
|
||||
hopefully more efficient.That won't be too hard, especially since I have
|
||||
direct data access now. (TClient FTW!)
|
||||
|
||||
Rewrite from scratch it will be, I guess.
|
||||
And AreaShape will be turned into a {$I }, inline simply doesn't cut it.
|
||||
|
||||
~Wizz
|
||||
}
|
||||
|
||||
|
||||
implementation
|
||||
uses
|
||||
Client, dtmutil, paszlib;
|
||||
|
||||
type
|
||||
TBufferByteArray = Array[0..524287] of Byte;
|
||||
PBufferByteArray = ^TBufferByteArray;
|
||||
|
||||
constructor TMDTM.Create(Owner: TObject);
|
||||
begin
|
||||
inherited Create;
|
||||
Self.Client := Owner;
|
||||
|
||||
SetLength(DTMList, 0);
|
||||
SetLength(FreeSpots, 0);
|
||||
SetLength(BufferString, 524288);
|
||||
end;
|
||||
|
||||
destructor TMDTM.Destroy;
|
||||
|
||||
begin
|
||||
SetLength(DTMList, 0);
|
||||
SetLength(FreeSpots, 0);
|
||||
SetLength(BufferString, 0);
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function HexToInt(HexNum: string): LongInt;inline;
|
||||
begin
|
||||
Result:=StrToInt('$' + HexNum);
|
||||
end;
|
||||
|
||||
function TMDTM.StringToDTM(S: String): pDTM;
|
||||
var
|
||||
b: PBufferByteArray;
|
||||
Source : String;
|
||||
DestLen : longword;
|
||||
i,ii,c : integer;
|
||||
begin
|
||||
SetLength(Result.p,0);
|
||||
SetLength(Result.c,0);
|
||||
SetLength(Result.t,0);
|
||||
SetLength(Result.asz,0);
|
||||
SetLength(Result.ash,0);
|
||||
ii := Length(S);
|
||||
if (ii = 0) or (ii mod 2 <> 0) then
|
||||
Exit;
|
||||
ii := ii div 2;
|
||||
SetLength(Source,ii);
|
||||
for i := 1 to ii do
|
||||
Source[i] := Chr(HexToInt(S[i * 2 - 1] + S[i * 2]));
|
||||
DestLen := Length(Self.BufferString);
|
||||
if uncompress(PChar(Self.Bufferstring),Destlen,pchar(Source), ii) = Z_OK then
|
||||
begin;
|
||||
if (Destlen mod 36) > 0 then
|
||||
begin;
|
||||
Writeln('Invalid DTM');
|
||||
Exit;
|
||||
end;
|
||||
DestLen := DestLen div 36;
|
||||
SetLength(Result.p,DestLen);
|
||||
SetLength(Result.c,DestLen);
|
||||
SetLength(Result.t,DestLen);
|
||||
SetLength(Result.asz,DestLen);
|
||||
SetLength(Result.ash,DestLen);
|
||||
b := @Self.Bufferstring[1];
|
||||
for i := 0 to DestLen - 1 do
|
||||
begin;
|
||||
c := i * 36;
|
||||
Result.p[i].x := PInteger(@b^[c+1])^;
|
||||
Result.p[i].y := PInteger(@b^[c+5])^;
|
||||
Result.asz[i] := PInteger(@b^[c+12])^;
|
||||
Result.ash[i] := PInteger(@b^[c+16])^;
|
||||
Result.c[i] := PInteger(@b^[c+20])^;
|
||||
Result.t[i] := PInteger(@b^[c+24])^;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMDTM.AddDTM(d: TDTM): Integer;
|
||||
|
||||
begin
|
||||
if Length(FreeSpots) > 0 then
|
||||
begin
|
||||
DTMList[FreeSpots[High(FreeSpots)]] := TDTMTopDTM(d);
|
||||
Result := FreeSpots[High(FreeSpots)];
|
||||
SetLength(FreeSpots, High(FreeSpots));
|
||||
end
|
||||
else
|
||||
begin
|
||||
SetLength(DTMList, Length(DTMList) + 1);
|
||||
DTMList[High(DTMList)] := TDTMTopDTM(d);
|
||||
Result := High(DTMList);
|
||||
end;
|
||||
end;
|
||||
|
||||
{/\
|
||||
Adds the given pDTM to the DTM Array, and returns it's index.
|
||||
/\}
|
||||
|
||||
function TMDTM.AddpDTM(d: pDTM): Integer;
|
||||
|
||||
begin
|
||||
if Length(FreeSpots) > 0 then
|
||||
begin
|
||||
DTMList[FreeSpots[High(FreeSpots)]] := d;
|
||||
Result := FreeSpots[High(FreeSpots)];
|
||||
SetLength(FreeSpots, High(FreeSpots));
|
||||
end
|
||||
Else
|
||||
begin
|
||||
SetLength(DTMList, Length(DTMList) + 1);
|
||||
DTMList[High(DTMList)] := d;
|
||||
Result := High(DTMList);
|
||||
end;
|
||||
end;
|
||||
|
||||
{/\
|
||||
Returns the DTM (pDTM type) in the variable dtm at the given index.
|
||||
Returns true is succesfull, false if the dtm does not exist.
|
||||
/\}
|
||||
|
||||
function TMDTM.GetDTM(index: Integer; var dtm: pDTM): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
try
|
||||
dtm := DTMList[index];
|
||||
except
|
||||
begin
|
||||
raise Exception.CreateFmt('The given DTM Index ([%d]) is invalid.',
|
||||
[index]);
|
||||
//WriteLn('DTM Index ' + IntToStr(index) + ' does not exist');
|
||||
Result := False;
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
{/\
|
||||
Unloads the DTM at the given index from the DTM Array.
|
||||
Notes:
|
||||
Will keep track of not used index, so it is very memory efficient.
|
||||
/\}
|
||||
|
||||
Procedure TMDTM.FreeDTM(DTM: Integer);
|
||||
begin
|
||||
try
|
||||
SetLength(DTMList[DTM].p, 0);
|
||||
SetLength(DTMList[DTM].c, 0);
|
||||
SetLength(DTMList[DTM].t, 0);
|
||||
SetLength(DTMList[DTM].asz, 0);
|
||||
SetLength(DTMList[DTM].ash, 0);
|
||||
except
|
||||
//WriteLn('Invalid DTM');
|
||||
end;
|
||||
SetLength(FreeSpots, Length(FreeSpots) + 1);
|
||||
FreeSpots[High(FreeSpots)] := DTM;
|
||||
end;
|
||||
|
||||
{
|
||||
Tries to find the given DTM (index). If found will put the point the dtm has
|
||||
been found at in x, y and result to true.
|
||||
}
|
||||
function TMDTM.FindDTM(DTM: Integer; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
|
||||
var
|
||||
temp: pDTM;
|
||||
begin
|
||||
if GetDTM(DTM, temp) then
|
||||
Result := pFindDTM(temp, x, y, x1, y1, x2, y2)
|
||||
else
|
||||
begin
|
||||
x := 0;
|
||||
y := 0;
|
||||
Result := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
Tries to find the given pDTM. If found will put the point the dtm has
|
||||
been found at in x, y and result to true.
|
||||
}
|
||||
|
||||
function TMDTM.pFindDTM(DTM: pDTM; var x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
|
||||
|
||||
var
|
||||
mP: TPointArray;
|
||||
I, J, H, dH: Integer;
|
||||
Found: Boolean;
|
||||
TempTP: TPoint;
|
||||
RetData: TRetData;
|
||||
|
||||
begin
|
||||
for I := 1 to High(DTM.p) do
|
||||
begin
|
||||
DTM.p[I].x := DTM.p[I].x - DTM.p[0].x;
|
||||
DTM.p[I].y := DTM.p[I].y - DTM.p[0].y;
|
||||
end;
|
||||
|
||||
// X2 := X2 - MaxSubPointDist.X
|
||||
// Y2 := Y2 - MaxSubPointDist.Y
|
||||
// X1 := X1 + MaxSubPointDist.X
|
||||
// Y1 := Y1 + MaxSubPointDist.Y
|
||||
// If X2 > X1 then Exit
|
||||
// If Y2 > Y1 then Exit
|
||||
// Will make sure there are no out of bounds exceptions, and will make it faster
|
||||
|
||||
TClient(Client).MWindow.Freeze();
|
||||
|
||||
TClient(Client).MFinder.FindColorsTolerance(mP, DTM.c[Low(DTM.c)],
|
||||
x1, y1, x2, y2, DTM.t[Low(DTM.t)]);
|
||||
|
||||
TClient(Client).MWindow.GetDimensions(H, dH);
|
||||
RetData := TClient(Client).MWindow.ReturnData(0, 0, H, dH);
|
||||
|
||||
H := High(mP);
|
||||
dH := High(DTM.p);
|
||||
for I := 0 to H do
|
||||
begin
|
||||
// Use MainPoint's AreaSize and Shape.
|
||||
// for Loop on mP, depending on the AreaShape. then on all the code beneath
|
||||
// this point, use the var that is retrieved from the for loop.
|
||||
Found := True;
|
||||
for J := 1 to dH do
|
||||
begin
|
||||
TempTP.X := DTM.p[J].X + mP[I].X;
|
||||
TempTP.Y := DTM.p[J].Y + mP[I].Y;
|
||||
//Now would be the time to Rotate TempTP
|
||||
//If Not AreaShape(DTM.c[J], DTM.t[J], DTM.asz[J], DTM.ash[J], TempTP) then
|
||||
if False then
|
||||
begin
|
||||
Found := False;
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Found then
|
||||
begin
|
||||
Result := True;
|
||||
x := mP[I].X;
|
||||
y := mP[I].Y;
|
||||
TClient(Client).MWindow.UnFreeze();
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
TClient(Client).MWindow.UnFreeze();
|
||||
Result := False;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user