1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 10:42:20 -05:00

Merge branch 'master' of ssh://villavu.com:54367/simba

This commit is contained in:
Merlijn Wajer 2010-04-14 00:24:09 +02:00
commit 48ad089549
8 changed files with 160 additions and 67 deletions

View File

@ -289,3 +289,13 @@ function ps_FindDeformedBitmapToleranceIn(bitmap: integer; out x,
begin;
result := CurrThread.Client.MFinder.FindDeformedBitmapToleranceIn(CurrThread.Client.MBitmaps[Bitmap],x,y,xs,ys,xe,ye,tolerance,range,AllowPartialAccuracy,accuracy);
end;
procedure ps_RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor); extdecl;
begin
CurrThread.Client.MBitmaps[bitmap].Rectangle(box,Color);
end;
procedure ps_FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor); extdecl;
begin
CurrThread.Client.MBitmaps[bitmap].FloodFill(startPoint,searchcol,replacecol);
end;

View File

@ -81,7 +81,7 @@ end;
function ps_GetDTM(index: Integer) : pDTM; extdecl;
begin
CurrThread.Client.MDTM.GetDTM(index);
result := CurrThread.Client.MDTM.GetDTM(index);
end;
function ps_AddDTM(const d: TDTM): Integer; extdecl;

View File

@ -21,44 +21,44 @@
PSCompile.inc for the Mufasa Macro Library
}
Sender.Comp.AddConstantN('AppPath','string').SetString(Self.AppPath);
Sender.Comp.AddConstantN('ScriptPath','string').SetString(Self.ScriptPath);
Sender.Comp.AddConstantN('IncludePath','string').SetString(Self.IncludePath);
Sender.Comp.AddConstantN('PluginPath','string').SetString(Self.PluginPath);
Sender.Comp.AddConstantN('FontPath','string').SetString(Self.FontPath);
Sender.Comp.AddTypeS('TReplaceFlag', '(rfReplaceAll, rfIgnoreCase)');
Sender.Comp.AddTypeS('TReplaceFlags','set of TReplaceFlag');
Sender.Comp.AddTypeS('StrExtr','(Numbers, Letters, Others);');
Sender.Comp.AddTypeS('TDateTime','Double');
Sender.Comp.AddTypeS('TIntegerArray', 'Array of LongInt');
Sender.Comp.AddTypeS('TByteArray','Array of byte');
Sender.Comp.AddTypeS('TExtendedArray','Array of extended');
Sender.Comp.AddTypeS('TBoolArray', 'Array of Boolean');
Sender.Comp.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;');
Sender.Comp.AddTypeS('TBoxArray','Array of TBox');
Sender.Comp.AddTypeS('TPointArray','Array of TPoint');
Sender.Comp.AddTypeS('T2DPointArray','Array of TPointArray');
Sender.Comp.AddTypeS('TPointArrayArray','Array of TPointArray');
Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
Sender.Comp.addtypeS('PPoint','record R,T : extended; end;');
Sender.Comp.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15:integer; end;');
x.AddConstantN('AppPath','string').SetString(Self.AppPath);
x.AddConstantN('ScriptPath','string').SetString(Self.ScriptPath);
x.AddConstantN('IncludePath','string').SetString(Self.IncludePath);
x.AddConstantN('PluginPath','string').SetString(Self.PluginPath);
x.AddConstantN('FontPath','string').SetString(Self.FontPath);
x.AddTypeS('TReplaceFlag', '(rfReplaceAll, rfIgnoreCase)');
x.AddTypeS('TReplaceFlags','set of TReplaceFlag');
x.AddTypeS('StrExtr','(Numbers, Letters, Others);');
x.AddTypeS('TDateTime','Double');
x.AddTypeS('TIntegerArray', 'Array of LongInt');
x.AddTypeS('TByteArray','Array of byte');
x.AddTypeS('TExtendedArray','Array of extended');
x.AddTypeS('TBoolArray', 'Array of Boolean');
x.AddTypes('TBox', 'record X1,Y1,X2,Y2 : Integer; end;');
x.AddTypeS('TBoxArray','Array of TBox');
x.AddTypeS('TPointArray','Array of TPoint');
x.AddTypeS('T2DPointArray','Array of TPointArray');
x.AddTypeS('TPointArrayArray','Array of TPointArray');
x.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
x.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
x.addtypeS('PPoint','record R,T : extended; end;');
x.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15:integer; end;');
Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
Sender.Comp.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');
Sender.Comp.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;');
Sender.Comp.AddTypeS('pDTM','record l: Integer;p: TPointArray;c, t, asz, ash: TIntegerArray; bp: Array Of Boolean; n: String; end;');
x.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
x.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;');
x.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;');
x.AddTypeS('pDTM','record l: Integer;p: TPointArray;c, t, asz, ash: TIntegerArray; bp: Array Of Boolean; n: String; end;');
Sender.Comp.AddTypeS('T2DExtendedArray', 'array of array of extended;');
Sender.Comp.AddTypeS('T3DExtendedArray','array of array of array of extended;');
Sender.Comp.AddTypeS('T2DIntegerArray','array of array of integer;');
Sender.Comp.AddTypeS('TStringArray','Array of string;');
Sender.Comp.AddTypeS('TMousePress', '(mouse_Down, mouse_Up);');
Sender.Comp.AddTypeS('Pointer', 'Integer');
x.AddTypeS('T2DExtendedArray', 'array of array of extended;');
x.AddTypeS('T3DExtendedArray','array of array of array of extended;');
x.AddTypeS('T2DIntegerArray','array of array of integer;');
x.AddTypeS('TStringArray','Array of string;');
x.AddTypeS('TMousePress', '(mouse_Down, mouse_Up);');
x.AddTypeS('Pointer', 'Integer');
Sender.Comp.AddTypeS('TSP_Property','(SP_WriteTimeStamp,SP_OnTerminate)');
x.AddTypeS('TSP_Property','(SP_WriteTimeStamp,SP_OnTerminate)');
Sender.Comp.AddConstantN('mouse_Right','integer').SetInt(ps_mouse_right); //0
Sender.Comp.AddConstantN('mouse_Left','integer').SetInt(ps_mouse_left);//1
Sender.Comp.AddConstantN('mouse_Middle','integer').SetInt(ps_mouse_middle);//2
x.AddConstantN('mouse_Right','integer').SetInt(ps_mouse_right); //0
x.AddConstantN('mouse_Left','integer').SetInt(ps_mouse_left);//1
x.AddConstantN('mouse_Middle','integer').SetInt(ps_mouse_middle);//2

View File

@ -292,6 +292,8 @@ AddFunction(@ps_DrawTPABitmap,'procedure DrawTPABitmap(bitmap: integer; TPA: TPo
AddFunction(@ps_DrawATPABitmap,'procedure DrawATPABitmap(bitmap: integer; ATPA: T2DPointArray);');
AddFunction(@ps_DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap: integer; ATPA: T2DPointArray; Colors: TIntegerArray);');
AddFunction(@ps_DrawBitmap,'procedure DrawBitmap(Bmp: Integer; Dest: TCanvas; x, y: Integer);');
AddFunction(@ps_RectangleBitmap,'procedure RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor);');
AddFunction(@ps_FloodfillBitmap,'procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor);');
{tpa}
SetCurrSection('TPA');

View File

@ -605,7 +605,6 @@ var
i,ii : integer;
Fonts : TMFonts;
begin
{$I PSInc/pscompile.inc}
Fonts := Client.MOCR.Fonts;
for i := fonts.count - 1 downto 0 do
Sender.Comp.AddConstantN(Fonts[i].Name,'string').SetString(Fonts[i].Name);
@ -647,6 +646,8 @@ begin
RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
RegisterMethod('procedure Rectangle(const Box : TBox; FillCol : TColor);');
RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);');
// function FastGetPixels(TPA : TPointArray) : TIntegerArray;
RegisterMethod('procedure SetTransparentColor(Col : TColor);');
RegisterMethod('function GetTransparentColor : TColor;');
@ -706,6 +707,8 @@ begin;
RegisterMethod(@TMufasaBitmap.FastSetPixels,'FASTSETPIXELS');
RegisterMethod(@TMufasaBitmap.DrawATPA,'DRAWATPA');
RegisterMethod(@TMufasaBitmap.DrawTPA,'DRAWTPA');
RegisterMethod(@TMufasaBitmap.FloodFill,'FLOODFILL');
RegisterMethod(@TMufasaBitmap.Rectangle,'RECTANGLE');
RegisterMethod(@TMufasaBitmap.FastGetPixel,'FASTGETPIXEL');
RegisterMethod(@TMufasaBitmap.SetTransparentColor,'SETTRANSPARENTCOLOR');
RegisterMethod(@TMufasaBitmap.GetTransparentColor,'GETTRANSPARENTCOLOR');
@ -744,6 +747,7 @@ begin
SIRegister_Forms(x);
SIRegister_ExtCtrls(x);
SIRegister_Menus(x);
{$I PSInc/pscompile.inc}
SIRegister_Mufasa(x);
with x.AddFunction('procedure writeln;').decl do
with AddParam do

View File

@ -52,15 +52,17 @@ type
procedure ValidatePoint(x,y : integer);
function SaveToFile(const FileName : string) :boolean;
procedure LoadFromFile(const FileName : string);
procedure Rectangle(const Box : TBox;FillCol : TColor);
procedure FloodFill(const StartPT : TPoint; const SearchCol, ReplaceCol : TColor);
procedure FastSetPixel(x,y : integer; Color : TColor);
procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);
procedure FastSetPixels(Points : TPointArray; Colors : TIntegerArray);
procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);overload;
procedure DrawATPA(ATPA : T2DPointArray);overload;
procedure DrawTPA(TPA : TPointArray; Color : TColor);
procedure DrawTPA(Points : TPointArray; Color : TColor);
procedure DrawToCanvas(x,y : integer; Canvas : TCanvas);
function CreateTPA(SearchCol : TColor) : TPointArray;
function FastGetPixel(x,y : integer) : TColor;
function FastGetPixels(TPA : TPointArray) : TIntegerArray;
function FastGetPixels(Points : TPointArray) : TIntegerArray;
procedure FastDrawClear(Color : TColor);
procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);
procedure FastReplaceColor(OldColor, NewColor: TColor);
@ -121,7 +123,7 @@ type
implementation
uses
paszlib,DCPbase64,math, client,
paszlib,DCPbase64,math, client,tpa,
colour_conv,IOManager,mufasatypesutil;
// Needs more fixing. We need to either copy the memory ourself, or somehow
@ -450,6 +452,66 @@ begin;
Result.A := 0;
end;
procedure TMufasaBitmap.Rectangle(const Box: TBox;FillCol: TColor);
var
y : integer;
Col : Longword;
Size : longword;
begin
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
raise exception.Create('The Box you passed to Rectangle exceed the bitmap''s bounds');
if (box.x1 > box.x2) or (Box.y1 > box.y2) then
raise exception.CreateFmt('The Box you passed to Rectangle doesn''t have normal bounds: (%d,%d) : (%d,%d)',
[Box.x1,box.y1,box.x2,box.y2]);
col := Longword(RGBToBGR(FillCol));
Size := Box.x2 - box.x1 + 1;
for y := Box.y1 to Box.y2 do
FillDWord(FData[y * self.w + Box.x1],size,Col);
end;
procedure TMufasaBitmap.FloodFill(const StartPT: TPoint; const SearchCol,
ReplaceCol: TColor);
var
Stack : TPointArray;
SIndex : Integer;
CurrX,CurrY : integer;
Search,Replace : LongWord;
procedure AddToStack(x,y : integer);
begin
if LongWord(FData[y * w + x]) = Search then
begin
LongWord(FData[y * w + x]) := Replace;
Stack[SIndex].x := x;
Stack[SIndex].y := y;
inc(SIndex);
end;
end;
begin
ValidatePoint(StartPT.x,StartPT.y);
Search := LongWord(RGBToBGR(SearchCol));
Replace := LongWord(RGBToBGR(ReplaceCol));
if LongWord(FData[StartPT.y * w + StartPT.x]) <> Search then //Only add items to the stack that are the searchcol.
Exit;
SetLength(Stack,w * h);
SIndex := 0;
AddToStack(StartPT.x,StartPT.y);
SIndex := 0;
while (SIndex >= 0) do
begin;
CurrX := Stack[SIndex].x;
Curry := Stack[SIndex].y;
if (CurrX > 0) and (CurrY > 0) then AddToStack(CurrX - 1, CurrY - 1);
if (CurrX > 0) then AddToStack(CurrX - 1, CurrY);
if (CurrX > 0) and (CurrY + 1 < h) then AddToStack(CurrX - 1, CurrY + 1);
if (CurrY + 1 < h) then AddToStack(CurrX , CurrY + 1);
if (CurrX + 1 < w) and (CurrY + 1 < h) then AddToStack(CurrX + 1, CurrY + 1);
if (CurrX + 1 < w) then AddToStack(CurrX + 1, CurrY );
if (CurrX + 1 < w) and (CurrY > 0) then AddToStack(CurrX + 1, CurrY - 1);
if (CurrY > 0) then AddToStack(CurrX , CurrY - 1);
Dec(SIndex);
end;
end;
function TMufasaBitmap.Copy: TMufasaBitmap;
begin
Result := TMufasaBitmap.Create;
@ -593,18 +655,20 @@ begin
FData[y*w+x] := RGBToBGR(Color);
end;
procedure TMufasaBitmap.FastSetPixels(TPA: TPointArray; Colors: TIntegerArray);
procedure TMufasaBitmap.FastSetPixels(Points: TPointArray; Colors: TIntegerArray);
var
i,len : integer;
Box : TBox;
begin
len := High(TPA);
len := High(Points);
if Len <> High(colors) then
Raise Exception.CreateFMT('TPA/Colors Length differ',[]);
Box := GetTPABounds(Points);
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
raise exception.Create('The Points you passed to FastSetPixels exceed the bitmap''s bounds')
else
for i := 0 to len do
begin;
ValidatePoint(TPA[i].x,TPA[i].y);
FData[TPA[i].y * w + TPA[i].x] := RGBToBGR(Colors[i]);
end;
FData[Points[i].y * w + Points[i].x] := RGBToBGR(Colors[i]);
end;
procedure TMufasaBitmap.DrawATPA(ATPA: T2DPointArray; Colors: TIntegerArray);
@ -612,6 +676,7 @@ var
lenTPA,lenATPA : integer;
i,ii : integer;
Color : TRGB32;
Box : TBox;
begin
lenATPA := High(ATPA);
if LenATPA <> High(colors) then
@ -620,12 +685,13 @@ begin
begin;
lenTPA := High(ATPA[i]);
Color := RGBToBGR(Colors[i]);
Box := GetTPABounds(ATPA[i]);
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
raise exception.Create('The Points you passed to DrawATPA exceed the bitmap''s bounds')
else
for ii := 0 to lenTPA do
begin;
ValidatePoint(ATPA[i][ii].x,ATPA[i][ii].y);
FData[ATPA[i][ii].y * w + ATPA[i][ii].x] := Color;
end;
end;
end;
@ -641,9 +707,9 @@ begin
DrawATPA(ATPA,Colors);
end;
procedure TMufasaBitmap.DrawTPA(TPA: TPointArray; Color: TColor);
procedure TMufasaBitmap.DrawTPA(Points: TPointArray; Color: TColor);
begin
DrawATPA(ConvArr([TPA]),ConvArr([Color]));
DrawATPA(ConvArr([Points]),ConvArr([Color]));
end;
procedure TMufasaBitmap.DrawToCanvas(x,y : integer; Canvas: TCanvas);
@ -685,17 +751,18 @@ begin
Result := BGRToRGB(FData[y*w+x]);
end;
function TMufasaBitmap.FastGetPixels(TPA: TPointArray): TIntegerArray;
function TMufasaBitmap.FastGetPixels(Points: TPointArray): TIntegerArray;
var
i,len : integer;
Box : TBox;
begin
len := high(TPA);
len := high(Points);
Box := GetTPABounds(Points);
if (Box.x1 < 0) or (Box.y1 < 0) or (Box.x2 >= self.w) or (Box.y2 >= self.h) then
raise exception.Create('The Points you passed to FastGetPixels exceed the bitmap''s bounds');
SetLength(result,len+1);
for i := 0 to len do
begin;
ValidatePoint(TPA[i].x,TPA[i].y);
Result[i] := BGRToRGB(FData[TPA[i].y*w + TPA[i].x]);
end;
Result[i] := BGRToRGB(FData[Points[i].y*w + Points[i].x]);
end;
procedure TMufasaBitmap.SetTransparentColor(Col: TColor);

View File

@ -103,6 +103,8 @@ var
i : integer;
begin;
i := 0;
if aDTM.l = 0 then
exit;
if adtm.n <> '' then
mDebugLn('Name: ' + aDTM.n);
mDebugLn('MainPoint ' + inttostr(aDTM.p[i].x) + ', ' + inttostr(aDTM.p[i].y) + ' col: ' + inttostr(aDTM.c[i]) + ', tol: ' + inttostr(aDTM.t[i]) + '; ashape ' + inttostr(aDTM.ash[i]) + ' asize ' + inttostr(aDTM.asz[i])+ ', Bad Point: ' + BoolToStr(aDTM.bp[i]));

View File

@ -1941,6 +1941,7 @@ var
// bounds
W, H: integer;
MA: TBox;
MaxX,MaxY : integer; //The maximum value X/Y can take (for subpoints)
// for loops, etc
xx, yy: integer;
@ -2018,6 +2019,9 @@ begin
MA.y1 := MA.y1 - y1;
MA.x2 := MA.x2 - x1;
MA.y2 := MA.y2 - y1;
MaxX := y2-y1;
MaxY := x2-x1;
//MA is now fixed to the new (0,0) box...
for yy := MA.y1 to MA.y2 do //Coord of the mainpoint in the search area
@ -2030,8 +2034,8 @@ begin
//With area it can go out of bounds, therefore this max/min check
StartX := max(0,xx - dtm.asz[i] + dtm.p[i].x);
StartY := max(0,yy - dtm.asz[i] + dtm.p[i].y);
EndX := Min(Ma.x2,xx + dtm.asz[i] + dtm.p[i].x);
EndY := Min(ma.y2,yy + dtm.asz[i] + dtm.p[i].y);
EndX := Min(MaxX,xx + dtm.asz[i] + dtm.p[i].x);
EndY := Min(MaxY,yy + dtm.asz[i] + dtm.p[i].y);
for xxx := StartX to EndX do //The search area for the subpoint
begin
for yyy := StartY to EndY do
@ -2041,7 +2045,7 @@ begin
begin
// Checking point i now. (Store that we matched it)
ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i);
// if SimilarColors(dtm.c[i], rgbtocolor(cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B), dtm.t[i]) then
// if SimilarColors(dtm.c[i], rgbtocolor(cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B), dtm.t[i]) then
if ColorSame(ccts,dtm.t[i],clR[i],clG[i],clB[i],cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B,hh[i],ss[i],ll[i],hmod,smod) then
b[xxx][yyy] := b[xxx][yyy] or (1 shl i);
end;
@ -2112,6 +2116,7 @@ var
// bounds
W, H: integer;
MA: TBox;
MaxX,MaxY : integer;//The maximum value a (subpoint) can have!
// for loops, etc
xx, yy: integer;
@ -2153,6 +2158,9 @@ begin
for i := 0 to DTM.l - 1 do
goodPoints[i] := not DTM.bp[i];
MaxX := x2 - x1;
MaxY := x2 - y1;
// Init data structure B.
W := x2 - x1;
H := y2 - y1;
@ -2224,8 +2232,8 @@ begin
//With area it can go out of bounds, therefore this max/min check
StartX := max(0,xx - DTM.asz[i] + DTMRot.p[i].x);
StartY := max(0,yy - DTM.asz[i] + DTMRot.p[i].y);
EndX := Min(Ma.x2,xx + DTM.asz[i] + DTMRot.p[i].x);
EndY := Min(ma.y2,yy + DTM.asz[i] + DTMRot.p[i].y);
EndX := Min(MaxX,xx + DTM.asz[i] + DTMRot.p[i].x);
EndY := Min(MaxY,yy + DTM.asz[i] + DTMRot.p[i].y);
for xxx := StartX to EndX do //The search area for the subpoint
begin
for yyy := StartY to EndY do