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

Revised DTM system.. Now DTM is an object, holding an Array of MDTM Points.

Browse Source
This commit is contained in:
Raymond 2010-05-19 16:01:01 +02:00
parent 51d7f5a4b2
commit 1a936b4500
11 changed files with 584 additions and 630 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
Units/MMLAddon/PSInc/Wrappers/dtm.inc
View File

@ -24,13 +24,13 @@
function ps_FindDTM(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; extdecl; function ps_FindDTM(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; extdecl;
begin begin
with CurrThread.Client do with CurrThread.Client do
result := MFinder.FindDTM(MDTM.GetDTM(DTM)^,x,y,xs,ys,xe,ye); result := MFinder.FindDTM(MDTMs[DTM],x,y,xs,ys,xe,ye);
end; end;
function ps_FindDTMs(DTM: Integer; var p: TPointArray; xs, ys, xe, ye: Integer): Boolean; extdecl; function ps_FindDTMs(DTM: Integer; var p: TPointArray; xs, ys, xe, ye: Integer): Boolean; extdecl;
begin begin
with CurrThread.Client do with CurrThread.Client do
result := MFinder.FindDTMs(MDTM.GetDTM(DTM)^, p, xs, ys, xe, ye); result := MFinder.FindDTMs(MDTMs[DTM], p, xs, ys, xe, ye);
end; end;
function ps_FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: function ps_FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; xs, ys, xe, ye:
@ -38,7 +38,7 @@ function ps_FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; xs, ys, x
var aFound: Extended): Boolean; extdecl; var aFound: Extended): Boolean; extdecl;
begin begin
with CurrThread.Client do with CurrThread.Client do
result := MFinder.FindDTMRotated(MDTM.GetDTM(DTM)^, x,y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,true); result := MFinder.FindDTMRotated(MDTMs[DTM], x,y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,true);
end; end;
function ps_FindDTMRotatedSE(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: function ps_FindDTMRotatedSE(DTM: Integer; var x, y: Integer; xs, ys, xe, ye:
@ -46,65 +46,65 @@ function ps_FindDTMRotatedSE(DTM: Integer; var x, y: Integer; xs, ys, xe, ye:
var aFound: Extended): Boolean; extdecl; var aFound: Extended): Boolean; extdecl;
begin begin
with CurrThread.Client do with CurrThread.Client do
result := MFinder.FindDTMRotated(MDTM.GetDTM(DTM)^, x, y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,false); result := MFinder.FindDTMRotated(MDTMs[DTM], x, y, xs, ys, xe, ye, sAngle, eAngle, aStep, aFound,false);
end; end;
function ps_FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray): Boolean; extdecl; function ps_FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray): Boolean; extdecl;
begin begin
with CurrThread.Client do with CurrThread.Client do
result := MFinder.FindDTMsRotated(MDTM.GetDTM(DTM)^, Points, xs, ys, xe, ye, result := MFinder.FindDTMsRotated(MDTMs[DTM], Points, xs, ys, xe, ye,
sAngle, eAngle, aStep, aFound, true); sAngle, eAngle, aStep, aFound, true);
end; end;
function ps_FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray): Boolean; extdecl; function ps_FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray): Boolean; extdecl;
begin begin
with CurrThread.Client do with CurrThread.Client do
result := MFinder.FindDTMsRotated(MDTM.GetDTM(DTM)^, Points, xs, ys, xe, ye, result := MFinder.FindDTMsRotated(MDTMs[DTM], Points, xs, ys, xe, ye,
sAngle, eAngle, aStep, aFound, false); sAngle, eAngle, aStep, aFound, false);
end; end;
procedure ps_SetDTMName(DTM : integer;const name : string); procedure ps_SetDTMName(DTM : integer;const name : string);
begin begin
CurrThread.Client.MDTM.SetDTMName(DTM,name); CurrThread.Client.MDTMs[DTM].Name := Name;
end; end;
function ps_DTMFromString(const DTMString: String): Integer; extdecl; function ps_DTMFromString(const DTMString: String): Integer; extdecl;
begin begin
With CurrThread.Client.MDTM do With CurrThread.Client.MDTMs do
Result := AddpDTM(StringToDTM(DTMString)); Result := AddDTM(StringToDTM(DTMString));
end; end;
procedure ps_FreeDTM(DTM: Integer); extdecl; procedure ps_FreeDTM(DTM: Integer); extdecl;
begin begin
CurrThread.Client.MDTM.FreeDTM(DTM); CurrThread.Client.MDTMs.FreeDTM(DTM);
end; end;
function ps_GetDTM(index: Integer) : pDTM; extdecl; function ps_GetDTM(index: Integer) : TMDTM; extdecl;
begin begin
result := CurrThread.Client.MDTM.GetDTM(index)^; result := CurrThread.Client.MDTMs[Index];
end; end;
function ps_AddDTM(const d: TDTM): Integer; extdecl; function ps_AddTSDTM(const d: TSDTM): Integer; extdecl;
begin begin
Result := CurrThread.Client.MDTM.AddDTM(d); Result := CurrThread.Client.MDTMs.AddDTM(d);
end; end;
function ps_AddpDTM(const d: pDTM): Integer; extdecl; function ps_AddDTM(const d: TMDTM): Integer; extdecl;
begin begin
Result := CurrThread.Client.MDTM.AddpDTM(d); Result := CurrThread.Client.MDTMs.AddDTM(d);
end; end;
procedure ps_PrintpDTM(const aDTM : pDTM);extdecl; procedure ps_PrintDTM(const aDTM : TMDTM);extdecl;
begin begin
PrintpDTM(aDTM); PrintDTM(aDTM);
end; end;
function ps_pDTMToTDTM(Const DTM: pDTM): TDTM;extdecl; function ps_MDTMToSDTM(Const DTM: TMDTM): TSDTM;extdecl;
begin begin
result := pDTMToTDTM(DTM); result := MDTMToSDTM(DTM);
end; end;
function ps_tDTMTopDTM(Const DTM: TDTM): pDTM;extdecl; function ps_SDTMToMDTM(Const DTM: TSDTM): TMDTM;extdecl;
begin begin
result := tDTMTopDTM(DTM); result := SDTMToMDTM(DTM);
end; end;

97
Units/MMLAddon/PSInc/pscmml.inc Normal file
View File

@ -0,0 +1,97 @@
procedure SIRegister_MML(cl: TPSPascalCompiler);
var
PSClass : TPSCompileTimeClass;
begin
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap');
with PSClass do
begin;
RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
RegisterMethod('procedure FastSetPixel(x,y : integer; Color : TColor);');
RegisterMethod('procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);');
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;');
RegisterProperty('TransparentColorSet','Boolean',iptR);
RegisterMethod('procedure FastDrawClear(Color : TColor);');
RegisterMethod('procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);');
RegisterMethod('procedure FastReplaceColor(OldColor, NewColor: TColor);');
RegisterMethod('procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );');
RegisterMethod('procedure Desaturate(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure GreyScale(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer);');
RegisterMethod('procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);');
RegisterMethod('procedure Invert(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);');
RegisterMethod('function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap;');
RegisterMethod('function ToString : string;');
RegisterMethod('function ToTBitmap : TBitmap;');
RegisterMethod('function CreateTMask : TMask;');
RegisterMethod('constructor create');
RegisterMethod('procedure Free');
RegisterMethod('function SaveToFile(const FileName : string) :boolean;');
RegisterMethod('procedure LoadFromFile(const FileName : string);');
RegisterProperty('Width','Integer',iptR);
RegisterProperty('Height','Integer',iptR);
RegisterProperty('Index','Integer',iptR);
RegisterProperty('Name','String',iptRW);
end;
with CL.AddClassN(CL.FindClass('Exception'),'ERegExpr') do
begin
RegisterProperty('ErrorCode', 'integer', iptrw);
RegisterProperty('CompilerErrorPos', 'integer', iptrw);
end;
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TRegExp');
with PSClass do
begin
RegisterMethod('Constructor Create');
RegisterMethod('Function VersionMajor : integer');
RegisterMethod('Function VersionMinor : integer');
RegisterProperty('Expression', 'String', iptrw);
RegisterProperty('ModifierStr', 'String', iptrw);
RegisterProperty('ModifierI', 'boolean', iptrw);
RegisterProperty('ModifierR', 'boolean', iptrw);
RegisterProperty('ModifierS', 'boolean', iptrw);
RegisterProperty('ModifierG', 'boolean', iptrw);
RegisterProperty('ModifierM', 'boolean', iptrw);
RegisterProperty('ModifierX', 'boolean', iptrw);
RegisterMethod('Function Exec( const AInputString : String) : boolean;');
RegisterMethod('Function ExecNext : boolean');
RegisterMethod('Function ExecPos( AOffset : integer) : boolean');
RegisterProperty('InputString', 'String', iptrw);
RegisterMethod('Function Substitute( const ATemplate : String) : String');
RegisterMethod('Procedure Split( AInputStr : String; APieces : TStrings)');
RegisterMethod('Function Replace( AInputStr : String; const AReplaceStr : String; AUseSubstitution : boolean) : String;');
RegisterProperty('SubExprMatchCount', 'integer', iptr);
RegisterProperty('MatchPos', 'integer integer', iptr);
RegisterProperty('MatchLen', 'integer integer', iptr);
RegisterProperty('Match', 'String integer', iptr);
RegisterMethod('Function LastError : integer');
RegisterMethod('Function ErrorMsg( AErrorID : integer) : String');
RegisterProperty('CompilerErrorPos', 'integer', iptr);
RegisterProperty('SpaceChars', 'String', iptrw);
RegisterProperty('WordChars', 'String', iptrw);
RegisterProperty('LineSeparators', 'String', iptrw);
RegisterProperty('LinePairedSeparator', 'String', iptrw);
RegisterMethod('Function InvertCaseFunction( const Ch : Char) : Char');
RegisterProperty('InvertCase', 'TRegExprInvertCaseFunction', iptrw);
RegisterMethod('Procedure Compile');
RegisterMethod('Function Dump : String');
end;
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMDTM');
with PSClass do
begin
RegisterMethod('constructor create;');
RegisterMethod('procedure free;');
RegisterProperty('Name','String',iptrw);
RegisterMethod('function ToString : string');
RegisterMethod('function Valid:boolean');
RegisterProperty('Count','Integer',iptrw);
RegisterProperty('Points','TMDTMPointArray',iptr);
end;
end;

9
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -46,10 +46,11 @@ x.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : intege
x.addtypeS('PPoint','record R,T : extended; 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;'); x.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15:integer; end;');
x.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;'); x.AddTypes('TSDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
x.AddTypes('TDTMPointDefArray', 'Array Of TDTMPointDef;'); x.AddTypes('TSDTMPointDefArray', 'Array Of TSDTMPointDef;');
x.AddTypes('TDTM','record MainPoint: TDTMPointDef; SubPoints: TDTMPointDefArray; end;'); x.AddTypes('TSDTM','record MainPoint: TSDTMPointDef; SubPoints: TSDTMPointDefArray; end;');
x.AddTypeS('pDTM','record l: Integer;p: TPointArray;c, t, asz, ash: TIntegerArray; bp: Array Of Boolean; n: String; end;'); x.AddTypes('TMDTMPoint','record x,y,c,t,asz : integer; bp : boolean; end;');
x.AddTypes('TMDTMPointArray','array of TMDTMPoint;');
x.AddTypeS('T2DExtendedArray', 'array of array of extended;'); x.AddTypeS('T2DExtendedArray', 'array of array of extended;');
x.AddTypeS('T3DExtendedArray','array of array of array of extended;'); x.AddTypeS('T3DExtendedArray','array of array of array of extended;');

13
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -37,12 +37,13 @@ AddFunction(@ps_FindDTMRotatedSE, 'function FindDTMRotatedSE(DTM: Integer; var x
AddFunction(@ps_FindDTMRotatedAlternating, 'function FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: Extended): Boolean;'); AddFunction(@ps_FindDTMRotatedAlternating, 'function FindDTMRotatedAlternating(DTM: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: Extended): Boolean;');
AddFunction(@ps_FindDTMsRotatedSE, 'function FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;'); AddFunction(@ps_FindDTMsRotatedSE, 'function FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_FindDTMsRotatedAlternating, 'function FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;'); AddFunction(@ps_FindDTMsRotatedAlternating, 'function FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray) : Boolean;');
AddFunction(@ps_addDTM, 'function AddDTM(const d: TDTM): Integer;'); AddFunction(@ps_addDTM, 'function AddMDTM(const d: TMDTM): Integer;');
AddFunction(@ps_addpDTM, 'function AddpDTM(const d: pDTM): Integer;'); AddFunction(@ps_addDTM, 'function AddDTM(const d: TMDTM): Integer;');
AddFunction(@ps_PrintpDTM, 'procedure PrintpDTM(const tDTM : pDTM);'); AddFunction(@ps_addTSDTM, 'function AddSDTM(const d: TSDTM): Integer;');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer) : pDTM'); AddFunction(@ps_PrintDTM, 'procedure PrintDTM(const DTM : TMDTM);');
AddFunction(@ps_pDTMToTDTM, 'function pDTMToTDTM(const DTM: pDTM): TDTM;'); AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer) : TMDTM');
AddFunction(@ps_tDTMTopDTM, 'function tDTMTopDTM(const DTM: TDTM): pDTM;'); AddFunction(@ps_MDTMToSDTM, 'function MDTMToSDTM(Const DTM: TMDTM): TSDTM;');
AddFunction(@ps_SDTMToMDTM, 'function SDTMToMDTM(Const DTM: TSDTM): TMDTM;');
{maths} {maths}
SetCurrSection('Math'); SetCurrSection('Math');

145
Units/MMLAddon/PSInc/psrmml.inc Normal file
View File

@ -0,0 +1,145 @@
type
TRegExp = class(SynRegExpr.TRegExpr);
procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin; Index := self.Index; end;
procedure MBmp_Width_r(self : TMufasaBitmap; var Width : integer);begin; Width := self.Width; end;
procedure MBmp_Height_r(self : TMufasaBitmap; var Height : integer);begin; Height := self.Height; end;
procedure MBmp_Name_r(self : TMufasaBitmap; var Name : String);begin; Name := self.Name; end;
procedure MBmp_Name_w(self : TMufasaBitmap; const Name : String);begin; Self.name := name; end;
procedure MBmp_TransColorSet_r(Self : TMufasaBitmap; var IsSet : boolean); begin IsSet := self.TransparentColorSet; end;
procedure ERegExprCompilerErrorPos_W(Self: ERegExpr; const T: integer); Begin Self.CompilerErrorPos := T; end;
procedure ERegExprCompilerErrorPos_R(Self: ERegExpr; var T: integer);Begin T := Self.CompilerErrorPos; end;
procedure ERegExprErrorCode_W(Self: ERegExpr; const T: integer);Begin Self.ErrorCode := T; end;
procedure ERegExprErrorCode_R(Self: ERegExpr; var T: integer);Begin T := Self.ErrorCode; end;
procedure TRegExprInvertCase_W(Self: TRegExp; const T: TRegExprInvertCaseFunction);begin Self.InvertCase := T; end;
procedure TRegExprInvertCase_R(Self: TRegExp; var T: TRegExprInvertCaseFunction);begin T := Self.InvertCase; end;
procedure TRegExprLinePairedSeparator_W(Self: TRegExp; const T: RegExprString);begin Self.LinePairedSeparator := T; end;
procedure TRegExprLinePairedSeparator_R(Self: TRegExp; var T: RegExprString);begin T := Self.LinePairedSeparator; end;
procedure TRegExprLineSeparators_W(Self: TRegExp; const T: RegExprString);begin Self.LineSeparators := T; end;
procedure TRegExprLineSeparators_R(Self: TRegExp; var T: RegExprString);begin T := Self.LineSeparators; end;
procedure TRegExprWordChars_W(Self: TRegExp; const T: RegExprString);begin Self.WordChars := T; end;
procedure TRegExprWordChars_R(Self: TRegExp; var T: RegExprString);begin T := Self.WordChars; end;
procedure TRegExprSpaceChars_W(Self: TRegExp; const T: RegExprString);begin Self.SpaceChars := T; end;
procedure TRegExprSpaceChars_R(Self: TRegExp; var T: RegExprString);begin T := Self.SpaceChars; end;
procedure TRegExprCompilerErrorPos_R(Self: TRegExp; var T: integer);begin T := Self.CompilerErrorPos; end;
procedure TRegExprMatch_R(Self: TRegExp; var T: RegExprString; const t1: integer);begin T := Self.Match[t1]; end;
procedure TRegExprMatchLen_R(Self: TRegExp; var T: integer; const t1: integer);begin T := Self.MatchLen[t1]; end;
procedure TRegExprMatchPos_R(Self: TRegExp; var T: integer; const t1: integer);begin T := Self.MatchPos[t1]; end;
procedure TRegExprSubExprMatchCount_R(Self: TRegExp; var T: integer);begin T := Self.SubExprMatchCount; end;
Function TRegExprReplace2_P(Self: TRegExp; AInputStr : RegExprString; AReplaceFunc : TRegExprReplaceFunction) : RegExprString;Begin Result := Self.Replace(AInputStr, AReplaceFunc); END;
Function TRegExprReplace_P(Self: TRegExp; AInputStr : RegExprString; const AReplaceStr : RegExprString; AUseSubstitution : boolean) : RegExprString;Begin Result := Self.Replace(AInputStr, AReplaceStr, AUseSubstitution); END;
procedure TRegExprInputString_W(Self: TRegExp; const T: RegExprString);begin Self.InputString := T; end;
procedure TRegExprInputString_R(Self: TRegExp; var T: RegExprString);begin T := Self.InputString; end;
Function TRegExprExec_P(Self: TRegExp; const AInputString : RegExprString) : boolean;Begin Result := Self.Exec(AInputString); END;
procedure TRegExprModifierX_W(Self: TRegExp; const T: boolean);begin Self.ModifierX := T; end;
procedure TRegExprModifierX_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierX; end;
procedure TRegExprModifierM_W(Self: TRegExp; const T: boolean);begin Self.ModifierM := T; end;
procedure TRegExprModifierM_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierM; end;
procedure TRegExprModifierG_W(Self: TRegExp; const T: boolean);begin Self.ModifierG := T; end;
procedure TRegExprModifierG_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierG; end;
procedure TRegExprModifierS_W(Self: TRegExp; const T: boolean);begin Self.ModifierS := T; end;
procedure TRegExprModifierS_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierS; end;
procedure TRegExprModifierR_W(Self: TRegExp; const T: boolean);begin Self.ModifierR := T; end;
procedure TRegExprModifierR_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierR; end;
procedure TRegExprModifierI_W(Self: TRegExp; const T: boolean);begin Self.ModifierI := T; end;
procedure TRegExprModifierI_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierI; end;
procedure TRegExprModifierStr_W(Self: TRegExp; const T: RegExprString);begin Self.ModifierStr := T; end;
procedure TRegExprModifierStr_R(Self: TRegExp; var T: RegExprString);begin T := Self.ModifierStr; end;
procedure TRegExprExpression_W(Self: TRegExp; const T: RegExprString);begin Self.Expression := T; end;
procedure TRegExprExpression_R(Self: TRegExp; var T: RegExprString);begin T := Self.Expression; end;
procedure TMDTMCount_W(Self: TMDTM; const T: Integer);begin Self.Count := T; end;
procedure TMDTMCount_R(Self: TMDTM; var T: Integer);begin T := Self.Count; end;
procedure TMDTMPoints_R(Self : TMDTM; var T : TMDTMPointArray); begin t := self.Points; end;
procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
var
PSClass : TPSRuntimeClass;
begin;
PSClass :=cl.Add(TMufasaBitmap);
with PSClass do
begin
RegisterMethod(@TMufasaBitmap.ToTBitmap,'ToTBitmap');
RegisterMethod(@TMufasaBitmap.SetSize,'SETSIZE');
RegisterMethod(@TMufasaBitmap.StretchResize,'STRETCHRESIZE');
RegisterMethod(@TMufasaBitmap.FastSetPixel,'FASTSETPIXEL');
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');
RegisterMethod(@TMufasaBitmap.FastDrawClear,'FASTDRAWCLEAR');
RegisterMethod(@TMufasaBitmap.FastDrawTransparent,'FASTDRAWTRANSPARENT');
RegisterMethod(@TMufasaBitmap.FastReplaceColor,'FASTREPLACECOLOR');
RegisterMethod(@TMufasaBitmap.RotateBitmap,'ROTATEBITMAP');
RegisterMethod(@TMufasaBitmap.Desaturate,'DESATURATE');
RegisterMethod(@TMufasaBitmap.GreyScale,'GREYSCALE');
RegisterMethod(@TMufasaBitmap.Brightness,'BRIGHTNESS');
RegisterMethod(@TMufasaBitmap.Contrast,'CONTRAST');
RegisterMethod(@TMufasaBitmap.Invert,'INVERT');
RegisterMethod(@TMufasaBitmap.Posterize,'POSTERIZE');
RegisterMethod(@TMufasaBitmap.Copy, 'COPY');
RegisterMethod(@TMufasaBitmap.ToString,'TOSTRING');
RegisterMethod(@TMufasaBitmap.CreateTMask,'CREATETMASK');
RegisterPropertyHelper(@MBmp_TransColorSet_r,nil,'TRANSPARENTCOLORSET');
RegisterPropertyHelper(@MBmp_Index_r,nil,'INDEX');
RegisterPropertyHelper(@MBmp_Width_r,nil,'WIDTH');
RegisterPropertyHelper(@MBmp_Height_r,nil,'HEIGHT');
RegisterPropertyHelper(@MBmp_Name_r,@MBmp_Name_w,'NAME');
RegisterConstructor(@TMufasaBitmap.Create,'CREATE');
RegisterMethod(@TMufasaBitmap.free,'FREE');
RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
RegisterMethod(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
end;
with CL.Add(ERegExpr) do
begin
RegisterPropertyHelper(@ERegExprErrorCode_R,@ERegExprErrorCode_W,'ErrorCode');
RegisterPropertyHelper(@ERegExprCompilerErrorPos_R,@ERegExprCompilerErrorPos_W,'CompilerErrorPos');
end;
with CL.Add(TRegExp) do
begin
RegisterConstructor(@TRegExp.Create, 'Create');
RegisterMethod(@TRegExp.VersionMajor, 'VersionMajor');
RegisterMethod(@TRegExp.VersionMinor, 'VersionMinor');
RegisterPropertyHelper(@TRegExprExpression_R,@TRegExprExpression_W,'Expression');
RegisterPropertyHelper(@TRegExprModifierStr_R,@TRegExprModifierStr_W,'ModifierStr');
RegisterPropertyHelper(@TRegExprModifierI_R,@TRegExprModifierI_W,'ModifierI');
RegisterPropertyHelper(@TRegExprModifierR_R,@TRegExprModifierR_W,'ModifierR');
RegisterPropertyHelper(@TRegExprModifierS_R,@TRegExprModifierS_W,'ModifierS');
RegisterPropertyHelper(@TRegExprModifierG_R,@TRegExprModifierG_W,'ModifierG');
RegisterPropertyHelper(@TRegExprModifierM_R,@TRegExprModifierM_W,'ModifierM');
RegisterPropertyHelper(@TRegExprModifierX_R,@TRegExprModifierX_W,'ModifierX');
RegisterMethod(@TRegExprExec_P, 'Exec');
RegisterMethod(@TRegExp.ExecNext, 'ExecNext');
RegisterMethod(@TRegExp.ExecPos, 'ExecPos');
RegisterPropertyHelper(@TRegExprInputString_R,@TRegExprInputString_W,'InputString');
RegisterMethod(@TRegExp.Substitute, 'Substitute');
RegisterMethod(@TRegExp.Split, 'Split');
RegisterMethod(@TRegExprReplace_P, 'Replace');
RegisterPropertyHelper(@TRegExprSubExprMatchCount_R,nil,'SubExprMatchCount');
RegisterPropertyHelper(@TRegExprMatchPos_R,nil,'MatchPos');
RegisterPropertyHelper(@TRegExprMatchLen_R,nil,'MatchLen');
RegisterPropertyHelper(@TRegExprMatch_R,nil,'Match');
RegisterMethod(@TRegExp.LastError, 'LastError');
RegisterVirtualMethod(@TRegExp.ErrorMsg, 'ErrorMsg');
RegisterPropertyHelper(@TRegExprCompilerErrorPos_R,nil,'CompilerErrorPos');
RegisterPropertyHelper(@TRegExprSpaceChars_R,@TRegExprSpaceChars_W,'SpaceChars');
RegisterPropertyHelper(@TRegExprWordChars_R,@TRegExprWordChars_W,'WordChars');
RegisterPropertyHelper(@TRegExprLineSeparators_R,@TRegExprLineSeparators_W,'LineSeparators');
RegisterPropertyHelper(@TRegExprLinePairedSeparator_R,@TRegExprLinePairedSeparator_W,'LinePairedSeparator');
RegisterMethod(@TRegExp.InvertCaseFunction, 'InvertCaseFunction');
RegisterPropertyHelper(@TRegExprInvertCase_R,@TRegExprInvertCase_W,'InvertCase');
RegisterMethod(@TRegExp.Compile, 'Compile');
RegisterMethod(@TRegExp.Dump, 'Dump');
end;
with CL.Add(TMDTM) do
begin
RegisterConstructor(@TMDTM.Create,'Create');
RegisterMethod(@TMDTM.Free,'Free');
RegisterMethod(@TMDTM.ToString,'ToString');
RegisterMethod(@TMDTM.Valid,'Valid');
RegisterPropertyHelper(@TMDTMCount_R,@TMDTMCount_W,'Count');
RegisterPropertyHelper(@TMDTMPoints_R,nil,'Points');
end;
end;

277
Units/MMLAddon/mmlpsthread.pas
View File

@ -215,6 +215,7 @@ uses
uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs, uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs,
files, files,
dialogs, dialogs,
dtm, //Dtms!
uPSR_extctrls, //Runtime-libs uPSR_extctrls, //Runtime-libs
Graphics, //For Graphics types Graphics, //For Graphics types
math, //Maths! math, //Maths!
@ -665,242 +666,11 @@ begin
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}'; '{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
end; end;
{$I PSInc/pscmml.inc}
procedure SIRegister_Mufasa(cl: TPSPascalCompiler); procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
var
PSClass : TPSCompileTimeClass;
begin begin
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap'); SIRegister_MML(cl);
with PSClass do
begin;
RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
RegisterMethod('procedure FastSetPixel(x,y : integer; Color : TColor);');
RegisterMethod('procedure FastSetPixels(TPA : TPointArray; Colors : TIntegerArray);');
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;');
RegisterProperty('TransparentColorSet','Boolean',iptR);
RegisterMethod('procedure FastDrawClear(Color : TColor);');
RegisterMethod('procedure FastDrawTransparent(x, y: Integer; TargetBitmap: TMufasaBitmap);');
RegisterMethod('procedure FastReplaceColor(OldColor, NewColor: TColor);');
RegisterMethod('procedure RotateBitmap(angle: Extended;TargetBitmap : TMufasaBitmap );');
RegisterMethod('procedure Desaturate(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure GreyScale(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Brightness(TargetBitmap : TMufasaBitmap; br : integer);');
RegisterMethod('procedure Contrast(TargetBitmap : TMufasaBitmap; co : Extended);');
RegisterMethod('procedure Invert(TargetBitmap : TMufasaBitmap);');
RegisterMethod('procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);');
RegisterMethod('function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap;');
RegisterMethod('function ToString : string;');
RegisterMethod('function ToTBitmap : TBitmap;');
RegisterMethod('function CreateTMask : TMask;');
RegisterMethod('constructor create');
RegisterMethod('procedure Free');
RegisterMethod('function SaveToFile(const FileName : string) :boolean;');
RegisterMethod('procedure LoadFromFile(const FileName : string);');
RegisterProperty('Width','Integer',iptR);
RegisterProperty('Height','Integer',iptR);
RegisterProperty('Index','Integer',iptR);
RegisterProperty('Name','String',iptRW);
end;
with CL.AddClassN(CL.FindClass('Exception'),'ERegExpr') do
begin
RegisterProperty('ErrorCode', 'integer', iptrw);
RegisterProperty('CompilerErrorPos', 'integer', iptrw);
end;
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TRegExp');
with PSClass do
begin
RegisterMethod('Constructor Create');
RegisterMethod('Function VersionMajor : integer');
RegisterMethod('Function VersionMinor : integer');
RegisterProperty('Expression', 'String', iptrw);
RegisterProperty('ModifierStr', 'String', iptrw);
RegisterProperty('ModifierI', 'boolean', iptrw);
RegisterProperty('ModifierR', 'boolean', iptrw);
RegisterProperty('ModifierS', 'boolean', iptrw);
RegisterProperty('ModifierG', 'boolean', iptrw);
RegisterProperty('ModifierM', 'boolean', iptrw);
RegisterProperty('ModifierX', 'boolean', iptrw);
RegisterMethod('Function Exec( const AInputString : String) : boolean;');
RegisterMethod('Function ExecNext : boolean');
RegisterMethod('Function ExecPos( AOffset : integer) : boolean');
RegisterProperty('InputString', 'String', iptrw);
RegisterMethod('Function Substitute( const ATemplate : String) : String');
RegisterMethod('Procedure Split( AInputStr : String; APieces : TStrings)');
RegisterMethod('Function Replace( AInputStr : String; const AReplaceStr : String; AUseSubstitution : boolean) : String;');
RegisterProperty('SubExprMatchCount', 'integer', iptr);
RegisterProperty('MatchPos', 'integer integer', iptr);
RegisterProperty('MatchLen', 'integer integer', iptr);
RegisterProperty('Match', 'String integer', iptr);
RegisterMethod('Function LastError : integer');
RegisterMethod('Function ErrorMsg( AErrorID : integer) : String');
RegisterProperty('CompilerErrorPos', 'integer', iptr);
RegisterProperty('SpaceChars', 'String', iptrw);
RegisterProperty('WordChars', 'String', iptrw);
RegisterProperty('LineSeparators', 'String', iptrw);
RegisterProperty('LinePairedSeparator', 'String', iptrw);
RegisterMethod('Function InvertCaseFunction( const Ch : Char) : Char');
RegisterProperty('InvertCase', 'TRegExprInvertCaseFunction', iptrw);
RegisterMethod('Procedure Compile');
RegisterMethod('Function Dump : String');
end;
end;
function CreateMufasaBitmap : TMufasaBitmap;
begin;
result := TMufasaBitmap.Create;
CurrThread.Client.MBitmaps.AddBMP(result);
end;
procedure FreeMufasaBitmap(Self : TMufasaBitmap);
begin;
CurrThread.Client.MBitmaps.FreeBMP(Self.Index);
end;
function TMufasaBitmapCopy(Self : TMufasaBitmap;const xs,ys,xe,ye : integer) : TMufasaBitmap;
begin
result := Self.Copy(xs,ys,xe,ye);
CurrThread.Client.MBitmaps.AddBMP(result);
end;
type
TRegExp = class(SynRegExpr.TRegExpr);
procedure MBmp_Index_r(self : TMufasaBitmap; var Index : integer);begin; Index := self.Index; end;
procedure MBmp_Width_r(self : TMufasaBitmap; var Width : integer);begin; Width := self.Width; end;
procedure MBmp_Height_r(self : TMufasaBitmap; var Height : integer);begin; Height := self.Height; end;
procedure MBmp_Name_r(self : TMufasaBitmap; var Name : String);begin; Name := self.Name; end;
procedure MBmp_Name_w(self : TMufasaBitmap; const Name : String);begin; Self.name := name; end;
procedure MBmp_TransColorSet_r(Self : TMufasaBitmap; var IsSet : boolean); begin IsSet := self.TransparentColorSet; end;
procedure ERegExprCompilerErrorPos_W(Self: ERegExpr; const T: integer); Begin Self.CompilerErrorPos := T; end;
procedure ERegExprCompilerErrorPos_R(Self: ERegExpr; var T: integer);Begin T := Self.CompilerErrorPos; end;
procedure ERegExprErrorCode_W(Self: ERegExpr; const T: integer);Begin Self.ErrorCode := T; end;
procedure ERegExprErrorCode_R(Self: ERegExpr; var T: integer);Begin T := Self.ErrorCode; end;
procedure TRegExprInvertCase_W(Self: TRegExp; const T: TRegExprInvertCaseFunction);begin Self.InvertCase := T; end;
procedure TRegExprInvertCase_R(Self: TRegExp; var T: TRegExprInvertCaseFunction);begin T := Self.InvertCase; end;
procedure TRegExprLinePairedSeparator_W(Self: TRegExp; const T: RegExprString);begin Self.LinePairedSeparator := T; end;
procedure TRegExprLinePairedSeparator_R(Self: TRegExp; var T: RegExprString);begin T := Self.LinePairedSeparator; end;
procedure TRegExprLineSeparators_W(Self: TRegExp; const T: RegExprString);begin Self.LineSeparators := T; end;
procedure TRegExprLineSeparators_R(Self: TRegExp; var T: RegExprString);begin T := Self.LineSeparators; end;
procedure TRegExprWordChars_W(Self: TRegExp; const T: RegExprString);begin Self.WordChars := T; end;
procedure TRegExprWordChars_R(Self: TRegExp; var T: RegExprString);begin T := Self.WordChars; end;
procedure TRegExprSpaceChars_W(Self: TRegExp; const T: RegExprString);begin Self.SpaceChars := T; end;
procedure TRegExprSpaceChars_R(Self: TRegExp; var T: RegExprString);begin T := Self.SpaceChars; end;
procedure TRegExprCompilerErrorPos_R(Self: TRegExp; var T: integer);begin T := Self.CompilerErrorPos; end;
procedure TRegExprMatch_R(Self: TRegExp; var T: RegExprString; const t1: integer);begin T := Self.Match[t1]; end;
procedure TRegExprMatchLen_R(Self: TRegExp; var T: integer; const t1: integer);begin T := Self.MatchLen[t1]; end;
procedure TRegExprMatchPos_R(Self: TRegExp; var T: integer; const t1: integer);begin T := Self.MatchPos[t1]; end;
procedure TRegExprSubExprMatchCount_R(Self: TRegExp; var T: integer);begin T := Self.SubExprMatchCount; end;
Function TRegExprReplace2_P(Self: TRegExp; AInputStr : RegExprString; AReplaceFunc : TRegExprReplaceFunction) : RegExprString;Begin Result := Self.Replace(AInputStr, AReplaceFunc); END;
Function TRegExprReplace_P(Self: TRegExp; AInputStr : RegExprString; const AReplaceStr : RegExprString; AUseSubstitution : boolean) : RegExprString;Begin Result := Self.Replace(AInputStr, AReplaceStr, AUseSubstitution); END;
procedure TRegExprInputString_W(Self: TRegExp; const T: RegExprString);begin Self.InputString := T; end;
procedure TRegExprInputString_R(Self: TRegExp; var T: RegExprString);begin T := Self.InputString; end;
Function TRegExprExec_P(Self: TRegExp; const AInputString : RegExprString) : boolean;Begin Result := Self.Exec(AInputString); END;
procedure TRegExprModifierX_W(Self: TRegExp; const T: boolean);begin Self.ModifierX := T; end;
procedure TRegExprModifierX_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierX; end;
procedure TRegExprModifierM_W(Self: TRegExp; const T: boolean);begin Self.ModifierM := T; end;
procedure TRegExprModifierM_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierM; end;
procedure TRegExprModifierG_W(Self: TRegExp; const T: boolean);begin Self.ModifierG := T; end;
procedure TRegExprModifierG_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierG; end;
procedure TRegExprModifierS_W(Self: TRegExp; const T: boolean);begin Self.ModifierS := T; end;
procedure TRegExprModifierS_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierS; end;
procedure TRegExprModifierR_W(Self: TRegExp; const T: boolean);begin Self.ModifierR := T; end;
procedure TRegExprModifierR_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierR; end;
procedure TRegExprModifierI_W(Self: TRegExp; const T: boolean);begin Self.ModifierI := T; end;
procedure TRegExprModifierI_R(Self: TRegExp; var T: boolean);begin T := Self.ModifierI; end;
procedure TRegExprModifierStr_W(Self: TRegExp; const T: RegExprString);begin Self.ModifierStr := T; end;
procedure TRegExprModifierStr_R(Self: TRegExp; var T: RegExprString);begin T := Self.ModifierStr; end;
procedure TRegExprExpression_W(Self: TRegExp; const T: RegExprString);begin Self.Expression := T; end;
procedure TRegExprExpression_R(Self: TRegExp; var T: RegExprString);begin T := Self.Expression; end;
procedure RIRegister_Mufasa(cl: TPSRuntimeClassImporter);
var
PSClass : TPSRuntimeClass;
begin;
PSClass :=cl.Add(TMufasaBitmap);
with PSClass do
begin
RegisterMethod(@TMufasaBitmap.ToTBitmap,'ToTBitmap');
RegisterMethod(@TMufasaBitmap.SetSize,'SETSIZE');
RegisterMethod(@TMufasaBitmap.StretchResize,'STRETCHRESIZE');
RegisterMethod(@TMufasaBitmap.FastSetPixel,'FASTSETPIXEL');
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');
RegisterMethod(@TMufasaBitmap.FastDrawClear,'FASTDRAWCLEAR');
RegisterMethod(@TMufasaBitmap.FastDrawTransparent,'FASTDRAWTRANSPARENT');
RegisterMethod(@TMufasaBitmap.FastReplaceColor,'FASTREPLACECOLOR');
RegisterMethod(@TMufasaBitmap.RotateBitmap,'ROTATEBITMAP');
RegisterMethod(@TMufasaBitmap.Desaturate,'DESATURATE');
RegisterMethod(@TMufasaBitmap.GreyScale,'GREYSCALE');
RegisterMethod(@TMufasaBitmap.Brightness,'BRIGHTNESS');
RegisterMethod(@TMufasaBitmap.Contrast,'CONTRAST');
RegisterMethod(@TMufasaBitmap.Invert,'INVERT');
RegisterMethod(@TMufasaBitmap.Posterize,'POSTERIZE');
RegisterMethod(@TMufasaBitmapCopy, 'COPY');
RegisterMethod(@TMufasaBitmap.ToString,'TOSTRING');
RegisterMethod(@TMufasaBitmap.CreateTMask,'CREATETMASK');
RegisterPropertyHelper(@MBmp_TransColorSet_r,nil,'TRANSPARENTCOLORSET');
RegisterPropertyHelper(@MBmp_Index_r,nil,'INDEX');
RegisterPropertyHelper(@MBmp_Width_r,nil,'WIDTH');
RegisterPropertyHelper(@MBmp_Height_r,nil,'HEIGHT');
RegisterPropertyHelper(@MBmp_Name_r,@MBmp_Name_w,'NAME');
RegisterConstructor(@CreateMufasaBitmap,'CREATE');
RegisterMethod(@FreeMufasaBitmap,'FREE');
RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
RegisterMethod(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
end;
with CL.Add(ERegExpr) do
begin
RegisterPropertyHelper(@ERegExprErrorCode_R,@ERegExprErrorCode_W,'ErrorCode');
RegisterPropertyHelper(@ERegExprCompilerErrorPos_R,@ERegExprCompilerErrorPos_W,'CompilerErrorPos');
end;
with CL.Add(TRegExp) do
begin
RegisterConstructor(@TRegExp.Create, 'Create');
RegisterMethod(@TRegExp.VersionMajor, 'VersionMajor');
RegisterMethod(@TRegExp.VersionMinor, 'VersionMinor');
RegisterPropertyHelper(@TRegExprExpression_R,@TRegExprExpression_W,'Expression');
RegisterPropertyHelper(@TRegExprModifierStr_R,@TRegExprModifierStr_W,'ModifierStr');
RegisterPropertyHelper(@TRegExprModifierI_R,@TRegExprModifierI_W,'ModifierI');
RegisterPropertyHelper(@TRegExprModifierR_R,@TRegExprModifierR_W,'ModifierR');
RegisterPropertyHelper(@TRegExprModifierS_R,@TRegExprModifierS_W,'ModifierS');
RegisterPropertyHelper(@TRegExprModifierG_R,@TRegExprModifierG_W,'ModifierG');
RegisterPropertyHelper(@TRegExprModifierM_R,@TRegExprModifierM_W,'ModifierM');
RegisterPropertyHelper(@TRegExprModifierX_R,@TRegExprModifierX_W,'ModifierX');
RegisterMethod(@TRegExprExec_P, 'Exec');
RegisterMethod(@TRegExp.ExecNext, 'ExecNext');
RegisterMethod(@TRegExp.ExecPos, 'ExecPos');
RegisterPropertyHelper(@TRegExprInputString_R,@TRegExprInputString_W,'InputString');
RegisterMethod(@TRegExp.Substitute, 'Substitute');
RegisterMethod(@TRegExp.Split, 'Split');
RegisterMethod(@TRegExprReplace_P, 'Replace');
RegisterPropertyHelper(@TRegExprSubExprMatchCount_R,nil,'SubExprMatchCount');
RegisterPropertyHelper(@TRegExprMatchPos_R,nil,'MatchPos');
RegisterPropertyHelper(@TRegExprMatchLen_R,nil,'MatchLen');
RegisterPropertyHelper(@TRegExprMatch_R,nil,'Match');
RegisterMethod(@TRegExp.LastError, 'LastError');
RegisterVirtualMethod(@TRegExp.ErrorMsg, 'ErrorMsg');
RegisterPropertyHelper(@TRegExprCompilerErrorPos_R,nil,'CompilerErrorPos');
RegisterPropertyHelper(@TRegExprSpaceChars_R,@TRegExprSpaceChars_W,'SpaceChars');
RegisterPropertyHelper(@TRegExprWordChars_R,@TRegExprWordChars_W,'WordChars');
RegisterPropertyHelper(@TRegExprLineSeparators_R,@TRegExprLineSeparators_W,'LineSeparators');
RegisterPropertyHelper(@TRegExprLinePairedSeparator_R,@TRegExprLinePairedSeparator_W,'LinePairedSeparator');
RegisterMethod(@TRegExp.InvertCaseFunction, 'InvertCaseFunction');
RegisterPropertyHelper(@TRegExprInvertCase_R,@TRegExprInvertCase_W,'InvertCase');
RegisterMethod(@TRegExp.Compile, 'Compile');
RegisterMethod(@TRegExp.Dump, 'Dump');
end;
end; end;
procedure TPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler); procedure TPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
@ -944,6 +714,45 @@ begin
end; end;
end; end;
{$I PSInc/psrmml.inc}
function TMufasaBitmapCreate : TMufasaBitmap;
begin;
result := TMufasaBitmap.Create;
CurrThread.Client.MBitmaps.AddBMP(result);
end;
procedure TMufasaBitmapFree(Self : TMufasaBitmap);begin; CurrThread.Client.MBitmaps.FreeBMP(Self.Index); end;
function TMufasaBitmapCopy(Self : TMufasaBitmap;const xs,ys,xe,ye : integer) : TMufasaBitmap;
begin
result := Self.Copy(xs,ys,xe,ye);
CurrThread.Client.MBitmaps.AddBMP(result);
end;
function TMDTMCreate : TMDTM;
begin
result := TMDTM.Create;
CurrThread.Client.MDTMs.AddDTM(result);
end;
procedure TMDTMFree(Self : TMDTM);
begin
CurrThread.Client.MDTMs.FreeDTM(self.Index);
end;
procedure RIRegister_Mufasa(CL: TPSRuntimeClassImporter);
begin
RIRegister_MML(cl);
//Overwrites the default stuff
with cl.FindClass('TMufasaBitmap') do
begin
RegisterConstructor(@TMufasaBitmapCreate,'Create');
RegisterMethod(@TMufasaBitmapFree,'Free');
RegisterMethod(@TMufasaBitmapCopy,'Copy');
end;
With cl.FindClass('TMDTM') do
begin
RegisterConstructor(@TMDTMCreate,'Create');
RegisterMethod(@TMDTMFree,'Free');
end;
end;
procedure TPSThread.OnExecImport(Sender: TObject; se: TPSExec; procedure TPSThread.OnExecImport(Sender: TObject; se: TPSExec;
x: TPSRuntimeClassImporter); x: TPSRuntimeClassImporter);
begin begin

6
Units/MMLCore/client.pas
View File

@ -47,7 +47,7 @@ type
MFiles: TMFiles; MFiles: TMFiles;
MFinder: TMFinder; MFinder: TMFinder;
MBitmaps : TMBitmaps; MBitmaps : TMBitmaps;
MDTM: TMDTM; MDTMs: TMDTMS;
MOCR: TMOCR; MOCR: TMOCR;
WritelnProc : TWritelnProc; WritelnProc : TWritelnProc;
procedure WriteLn(s : string); procedure WriteLn(s : string);
@ -76,7 +76,7 @@ begin
MFiles := TMFiles.Create(self); MFiles := TMFiles.Create(self);
MFinder := TMFinder.Create(Self); MFinder := TMFinder.Create(Self);
MBitmaps := TMBitmaps.Create(self); MBitmaps := TMBitmaps.Create(self);
MDTM := TMDTM.Create(self); MDTMs := TMDTMS.Create(self);
MOCR := TMOCR.Create(self); MOCR := TMOCR.Create(self);
end; end;
@ -85,7 +85,7 @@ begin
IOManager.SetState(True); IOManager.SetState(True);
MOCR.Free; MOCR.Free;
MDTM.Free; MDTMs.Free;
MBitmaps.Free; MBitmaps.Free;
MFinder.Free; MFinder.Free;
MFiles.Free; MFiles.Free;

220
Units/MMLCore/dtm.pas
View File

@ -34,20 +34,36 @@ type
{ TMDTM } { TMDTM }
{ TMDTM }
TMDTM = class(TObject) TMDTM = class(TObject)
private
FPoints : TMDTMPointArray;
FLen : integer;
function GetPointerPoints: PMDTMPoint;
procedure SetPointCount(const AValue: integer);
public
Name : string;
Index : integer;
function ToString : string;
function Valid : boolean;
property PPoints : PMDTMPoint read GetPointerPoints;
property Count : integer read FLen write SetPointCount;
property Points : TMDTMPointArray read FPoints;
end;
TMDTMS = class(TObject) //Manages the DTMs TMufasaDTMs
private private
Client: TObject; Client: TObject;
DTMList: Array Of PpDTM; DTMList: Array Of TMDTM;
FreeSpots: Array Of Integer; FreeSpots: Array Of Integer;
procedure CheckIndex(index : integer); procedure CheckIndex(index : integer);
public public
function AddDTM(const d: TDTM): Integer; function AddDTM(const d: TSDTM): Integer;overload;
function AddpDTM(const d: pDTM): Integer; function AddDTM(const d: TMDTM): Integer;overload;
function GetDTM(index: Integer) :ppDTM; function GetDTM(index: Integer) :TMDTM;
procedure FreeDTM(DTM: Integer); procedure FreeDTM(DTM: Integer);
function StringToDTM(const S: String): pDTM; function StringToDTM(const S: String): TMDTM;
function DTMToString(const DTM : PDTM) : string; property DTM[Index : integer]: TMDTM read GetDTM; default;
procedure SetDTMName(DTM: Integer;const S: String);
constructor Create(Owner: TObject); constructor Create(Owner: TObject);
destructor Destroy; override; destructor Destroy; override;
end; end;
@ -63,7 +79,7 @@ uses
constructor TMDTM.Create(Owner: TObject); constructor TMDTMS.Create(Owner: TObject);
begin begin
inherited Create; inherited Create;
Self.Client := Owner; Self.Client := Owner;
@ -73,7 +89,7 @@ begin
end; end;
{$DEFINE DTM_DEBUG} {$DEFINE DTM_DEBUG}
destructor TMDTM.Destroy; destructor TMDTMS.Destroy;
var var
i, j: integer; i, j: integer;
b:boolean; b:boolean;
@ -91,8 +107,8 @@ begin
end; end;
if not b then if not b then
begin; begin;
if DTMList[i]^.n <> '' then if DTMList[i].name <> '' then
WriteStr := WriteStr + DTMList[i]^.n + ', ' WriteStr := WriteStr + DTMList[i].name + ', '
else else
WriteStr := WriteStr + inttostr(i) + ', '; WriteStr := WriteStr + inttostr(i) + ', ';
FreeDTM(i); FreeDTM(i);
@ -123,18 +139,15 @@ begin
Result:=StrToInt('$' + HexNum); Result:=StrToInt('$' + HexNum);
end; end;
function TMDTM.StringToDTM(const S: String): pDTM; function TMDTMS.StringToDTM(const S: String): TMDTM;
var var
b: PBufferByteArray; b: PBufferByteArray;
Source : String; Source : String;
DestLen : longword; DestLen : longword;
i,ii,c : integer; i,ii,c : integer;
DPoints : PMDTMPoint;
begin begin
SetLength(Result.p,0); Result := TMDTM.Create;
SetLength(Result.c,0);
SetLength(Result.t,0);
SetLength(Result.asz,0);
SetLength(Result.ash,0);
ii := Length(S); ii := Length(S);
if (ii = 0) or (ii mod 2 <> 0) then if (ii = 0) or (ii mod 2 <> 0) then
Exit; Exit;
@ -148,58 +161,41 @@ begin
if (Destlen mod 36) > 0 then if (Destlen mod 36) > 0 then
raise Exception.CreateFmt('Invalid DTM passed to StringToDTM: %s',[s]); raise Exception.CreateFmt('Invalid DTM passed to StringToDTM: %s',[s]);
DestLen := DestLen div 36; DestLen := DestLen div 36;
SetLength(Result.p,DestLen); Result.Count:= DestLen;
SetLength(Result.c,DestLen); DPoints := result.PPoints;
SetLength(Result.t,DestLen);
SetLength(Result.asz,DestLen);
SetLength(Result.ash,DestLen);
SetLength(Result.bp,DestLen);
b := PBufferByteArray(BufferString); b := PBufferByteArray(BufferString);
for i := 0 to DestLen - 1 do for i := 0 to DestLen - 1 do
begin; begin;
c := i * 36; c := i * 36;
Result.p[i].x := PInteger(@b^[c+1])^; DPoints[i].x := PInteger(@b^[c+1])^;
Result.p[i].y := PInteger(@b^[c+5])^; DPoints[i].y := PInteger(@b^[c+5])^;
Result.asz[i] := PInteger(@b^[c+12])^; DPoints[i].asz := PInteger(@b^[c+12])^;
Result.ash[i] := PInteger(@b^[c+16])^; // Result.ash[i] := PInteger(@b^[c+16])^;
Result.c[i] := PInteger(@b^[c+20])^; DPoints[i].c := PInteger(@b^[c+20])^;
Result.t[i] := PInteger(@b^[c+24])^; DPoints[i].t := PInteger(@b^[c+24])^;
Result.bp[i] := False; DPoints[i].bp := False;
end; end;
end; end;
result.l := length(result.p);
end; end;
function TMDTM.DTMToString(const DTM: PDTM): string; procedure TMDTMS.CheckIndex(index: integer);
var
i : integer;
begin
if DTM.l = 0 then
exit;
end;
procedure TMDTM.CheckIndex(index: integer);
begin begin
if (index < 0) or (index >= Length(DTMList)) or (DTMList[Index] = nil) then if (index < 0) or (index >= Length(DTMList)) or (DTMList[Index] = nil) then
raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]); raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]);
end; end;
function TMDTM.AddDTM(const d: TDTM): Integer; function TMDTMS.AddDTM(const d: TSDTM): Integer;
begin begin
Result := AddpDTM(tDTMTopDTM(d)); Result := AddDTM(SDTMToMDTM(d));
end; end;
{/\ {/\
Adds the given pDTM to the DTM Array, and returns it's index. Adds the given pDTM to the DTM Array, and returns it's index.
/\} /\}
function TMDTM.AddpDTM(const d: pDTM): Integer; function TMDTMS.AddDTM(const d: TMDTM): Integer;
var
NewDTM : PpDTM;
begin begin
New(NewDTM);
NewDTM^ := d;
if Length(FreeSpots) > 0 then if Length(FreeSpots) > 0 then
begin begin
@ -211,8 +207,9 @@ begin
SetLength(DTMList, Length(DTMList) + 1); SetLength(DTMList, Length(DTMList) + 1);
Result := High(DTMList); Result := High(DTMList);
end; end;
DTMList[Result] := NewDTM; DTMList[Result] := d;
NormalizeDTM(DTMList[result]^); DTMList[Result].Index:= Result;
NormalizeDTM(DTMList[result]);
end; end;
{/\ {/\
@ -220,130 +217,55 @@ end;
Returns true is succesfull, false if the dtm does not exist. Returns true is succesfull, false if the dtm does not exist.
/\} /\}
function TMDTM.GetDTM(index: Integer) :ppDTM; function TMDTMS.GetDTM(index: Integer) :TMDTM;
begin begin
CheckIndex(index); CheckIndex(index);
result := DTMList[index]; result := DTMList[index];
end; end;
procedure TMDTM.SetDTMName(DTM: Integer;const s: string);
begin
CheckIndex(DTM);
DTMList[DTM]^.n := s;
end;
{/\ {/\
Unloads the DTM at the given index from the DTM Array. Unloads the DTM at the given index from the DTM Array.
Notes: Notes:
Will keep track of not used index, so it is very memory efficient. Will keep track of not used index, so it is very memory efficient.
/\} /\}
procedure TMDTM.FreeDTM(DTM: Integer); procedure TMDTMS.FreeDTM(DTM: Integer);
begin begin
CheckIndex(DTM); CheckIndex(DTM);
with DTMList[DTM]^ do DTMList[DTM].Free;
begin
SetLength(p, 0);
SetLength(c, 0);
SetLength(t, 0);
SetLength(asz, 0);
SetLength(ash, 0);
SetLength(bp,0);
l := 0;
n := '';
end;
Dispose(DTMList[DTM]);
DTMList[DTM] := nil; DTMList[DTM] := nil;
SetLength(FreeSpots, Length(FreeSpots) + 1); SetLength(FreeSpots, Length(FreeSpots) + 1);
FreeSpots[High(FreeSpots)] := DTM; FreeSpots[High(FreeSpots)] := DTM;
end; end;
{wat} { TMDTM }
// Then, first find all occurances of all colours on the given client.
// Each point has a colour, and we call them C_0...C_n.
// MP denotes the points of the main point colour on the client.
// P_i denotes the points on the client for C_i
// O_i denotes the point offset, and possible area shape and size.
// B_i denotes a boolean representation of P_i for C_i, for C_1...C_n.
// B_0 and O_0 are the merry exception here, as we don't need them for C_0,
// which we will show later.
// I hope it is clear how this will be respresented in computer data function TMDTM.GetPointerPoints: PMDTMPoint;
// structures. begin
if count < 1 then
// Now, we iterate for i in range(1, n), result := nil
// We use MP_i, and iterate for j in range(0, dtm_points),
// Calculate the B_j indices (with MP_i and O_j) for each j, and
// see if B_j is not true, go on with MP_i + 1.
// Possible using areasize/shape.
// else, if B_j is true, continue with this inner loop.
// If B_{0...dtm_points} were all true, the point is valid.
{/\
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.
Will rotate the DTM starting at sAngle, increasing by aStep until eAngle has been reached, or when the DTM has been found.
Returns all Angles in an Extended array.
/\}
{function TMDTM.FindDTMRotated(DTM: Integer; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean;
Var
temp: pDTM;
Begin
If GetDTM(DTM, temp) Then
Result := pFindDTMRotated(temp, x, y, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound)
else else
Begin result := @FPoints[0];
x := 0; end;
y := 0;
aFound := 0.0;
Result := False;
end;
end; }
{/\ procedure TMDTM.SetPointCount(const AValue: integer);
Tries to find the given pDTM. If found will put the point the dtm has begin
been found at in x, y and result to true. SetLength(FPoints,AValue);
Will rotate the DTM starting at sAngle, increasing by aStep until eAngle has been reached, or when the DTM has been found. FLen := AValue;
Returns all Angles in an Extended array. end;
/\}
{function TMDTM.pFindDTMRotated(DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended): Boolean; function TMDTM.ToString: string;
begin
Begin end;
end; } function TMDTM.Valid: boolean;
begin
{/\ result := false;
Tries to find the given DTM (index). Will return true if it has found one or more if Count < 1 then
DTM's. All the occurances are stored in the Points (TPointArray) exit;
Will rotate the DTM starting at sAngle, increasing by aStep until eAngle has been reached. result := true;
Does not stop rotating when one occurance of a DTM has been found. end;
Returns all Angles in a Two Dimensional Extended array.
/\}
{function TMDTM.FindDTMsRotated(DTM: Integer; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray): Boolean;
Var
temp: pDTM;
Begin
If GetDTM(DTM, temp) Then
Result := pFindDTMsRotated(temp, Points, x1, y1, x2, y2, sAngle, eAngle, aStep, aFound)
else
Begin
SetLength(Points, 0);
SetLength(aFound, 0);
Result := False;
end;
end; }
{/\
Tries to find the given pDTM. Will return true if it has found one or more
DTM's. All the occurances are stored in the Points (TPointArray)
Will rotate the DTM starting at sAngle, increasing by aStep until eAngle has been reached.
Does not stop rotating when one occurance of a DTM has been found.
Returns all Angles in a Two Dimensional Extended array.
/\}
end. end.

222
Units/MMLCore/dtmutil.pas
View File

@ -28,21 +28,21 @@ unit dtmutil;
interface interface
uses uses
Classes, SysUtils, MufasaTypes; Classes, SysUtils, dtm,tpa,MufasaTypes;
function pDTMToTDTM(Const DTM: pDTM): TDTM; function MDTMToSDTM(Const DTM: TMDTM): TSDTM;
function tDTMTopDTM(Const DTM: TDTM): pDTM; function SDTMToMDTM(Const DTM: TSDTM): TMDTM;
procedure PrintpDTM(const aDTM : pDTM); procedure PrintDTM(const aDTM : TMDTM);
procedure initdtm(out d: pdtm; len: integer); {procedure iniTSDTM(out d: TMDTM; len: integer);}
function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox; function ValidMainPointBox(var dtm: TMDTM; const x1, y1, x2, y2: Integer): TBox;
function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;const function ValidMainPointBox(const TPA: TPointArray; const x1, y1, x2, y2: Integer): TBox;
function ValidMainPointBoxRotated(var dtm: TMDTM; const x1, y1, x2, y2: Integer;const
sAngle, eAngle, aStep: Extended): TBox; sAngle, eAngle, aStep: Extended): TBox;
function DTMConsistent(const dtm: pdtm): boolean; procedure NormalizeDTM(var dtm: TMDTM);
procedure NormalizeDTM(var dtm: pdtm); {function RotateDTM(const dtm: TMDTM; angle: extended) : TMDTM;
function RotateDTM(const dtm: pdtm; angle: extended) : pdtm; function copydtm(const dtm: TMDTM): TMDTM; }
function copydtm(const dtm: pdtm): pdtm;
const const
dtm_Rectangle = 0; dtm_Rectangle = 0;
@ -71,164 +71,99 @@ Begin
// I recon it's faster than Point(). // I recon it's faster than Point().
End; End;
// macro
procedure initdtm(out d: pdtm; len: integer);
var
i: integer = 0;
begin
d.l := len;
d.n := '';
setlength(d.p, len);
setlength(d.c, len);
setlength(d.t, len);
setlength(d.ash, len);
setlength(d.asz, len);
setlength(d.bp, len);
FillChar(d.p[0], SizeOf(TPoint) * len, 0);
FillChar(d.c[0], SizeOf(Integer) * len, 0);
FillChar(d.t[0], SizeOf(Integer) * len, 0);
FillChar(d.ash[0], SizeOf(Integer) * len, 0);
// Better set it to 1, than fill with 0. procedure PrintDTM(const aDTM : TMDTM);
FillChar(d.asz[0], SizeOf(Integer) * len, 0);
//FillChar(d.gp[0], SizeOf(Boolean) * len, 0);
for i := 0 to len - 1 do
d.bp[i] := False;
end;
procedure PrintpDTM(const aDTM : pDTM);
var var
i : integer; i : integer;
begin; begin;
i := 0; i := 0;
if aDTM.l = 0 then if aDTM.count = 0 then
exit; exit;
if adtm.n <> '' then if adtm.Name <> '' then
mDebugLn('Name: ' + aDTM.n); mDebugLn('Name: ' + aDTM.name);
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])); mDebugLn('MainPoint ' + inttostr(aDTM.Points[i].x) + ', ' + inttostr(aDTM.Points[i].y) + ' col: ' + inttostr(aDTM.Points[i].c) + ', tol: ' + inttostr(aDTM.Points[i].t) + ', asize: ' + inttostr(aDTM.Points[i].asz)+ ', Bad Point: ' + BoolToStr(aDTM.Points[i].bp));
for I := 1 to High(aDTM.p) do for I := 1 to High(aDTM.Points) do
mDebugLn('SubPoint['+IntToStr(I) + '] ' + 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])); mDebugLn('SubPoint['+IntToStr(I) + '] ' + inttostr(aDTM.Points[i].x) + ', ' + inttostr(aDTM.Points[i].y) + ' col: ' + inttostr(aDTM.Points[i].c) + ', tol: ' + inttostr(aDTM.Points[i].t) +', asize: ' + inttostr(aDTM.Points[i].asz) + ', Bad Point: ' + BoolToStr(aDTM.Points[i].bp));
end; end;
function pDTMToTDTM(Const DTM: pDTM): TDTM; function MDTMToSDTM(Const DTM: TMDTM): TSDTM;
Var Var
Temp: TDTMPointDef; Temp: TSDTMPointDef;
I: Integer; I: Integer;
Begin Begin
For I := 0 To 0 Do For I := 0 To 0 Do
Begin Begin
Temp.X := DTM.p[i].x; Temp.X := DTM.Points[i].x;
Temp.Y := DTM.p[i].y; Temp.Y := DTM.Points[i].y;
Temp.AreaSize := DTM.asz[i]; Temp.AreaSize := DTM.Points[i].asz;
Temp.AreaShape := DTM.ash[i]; Temp.AreaShape := 0;
Temp.Color := DTM.c[i]; Temp.Color := DTM.Points[i].c;
Temp.Tolerance := DTM.t[i]; Temp.Tolerance := DTM.Points[i].t;
End; End;
Result.MainPoint := Temp; Result.MainPoint := Temp;
SetLength(Result.SubPoints, Length(DTM.p) - 1); SetLength(Result.SubPoints, DTM.Count - 1);
For I := 1 To DTM.l-1 Do For I := 1 To DTM.Count-1 Do
Begin Begin
Temp.X := 0; Temp.Y := 0; Temp.AreaSize := 0; Temp.AreaShape := 0; Temp.Color := 0; Temp.Tolerance := 0; Temp.X := 0; Temp.Y := 0; Temp.AreaSize := 0; Temp.AreaShape := 0; Temp.Color := 0; Temp.Tolerance := 0;
Temp.X := DTM.p[i].x; Temp.X := DTM.Points[i].x;
Temp.Y := DTM.p[i].y; Temp.Y := DTM.Points[i].y;
Temp.AreaSize := DTM.asz[i]; Temp.AreaSize := DTM.Points[i].asz;
Temp.AreaShape := DTM.ash[i]; Temp.AreaShape := 0;
Temp.Color := DTM.c[i]; Temp.Color := DTM.Points[i].c;
Temp.Tolerance := DTM.t[i]; Temp.Tolerance := DTM.Points[i].t;
Result.SubPoints[I - 1] := Temp; Result.SubPoints[I - 1] := Temp;
End; End;
End; End;
{/\ {/\
Converts a TDTM to a pDTM. Converts a TSDTM to a TMDTM.
/\} /\}
function tDTMTopDTM(Const DTM: TDTM): pDTM; function SDTMToMDTM(Const DTM: TSDTM): TMDTM;
var var
I: Integer; I: Integer;
begin begin
Result.l := Length(DTM.SubPoints) + 1; //The mainpoint is in a different structure Result.Count := Length(DTM.SubPoints) + 1; //The mainpoint is in a different structure
SetLength(Result.p, Result.l);
SetLength(Result.c, Result.l);
SetLength(Result.t, Result.l);
SetLength(Result.asz, Result.l);
SetLength(Result.ash, Result.l);
SetLength(Result.bp, Result.l);
Result.p[0].x := DTM.MainPoint.x; Result.Points[0].x := DTM.MainPoint.x;
Result.p[0].y := DTM.MainPoint.y; Result.Points[0].y := DTM.MainPoint.y;
Result.c[0] := DTM.MainPoint.Color; Result.Points[0].c := DTM.MainPoint.Color;
Result.t[0] := DTM.MainPoint.Tolerance; Result.Points[0].t := DTM.MainPoint.Tolerance;
Result.asz[0] := DTM.MainPoint.AreaSize; Result.Points[0].asz := DTM.MainPoint.AreaSize;
Result.ash[0] := DTM.MainPoint.AreaShape;
For I := 1 To Result.l - 1 Do // High + 1 = Length For I := 1 To Result.Count - 1 Do // High + 1 = Length
Begin Begin
Result.p[I].x := DTM.SubPoints[I - 1].x; Result.Points[I].x := DTM.SubPoints[I - 1].x;
Result.p[I].y := DTM.SubPoints[I - 1].y; Result.Points[I].y := DTM.SubPoints[I - 1].y;
Result.c[I] := DTM.SubPoints[I - 1].Color; Result.Points[I].c := DTM.SubPoints[I - 1].Color;
Result.t[I] := DTM.SubPoints[I - 1].Tolerance; Result.Points[I].t := DTM.SubPoints[I - 1].Tolerance;
Result.asz[I] := DTM.SubPoints[I - 1].AreaSize; Result.Points[I].asz := DTM.SubPoints[I - 1].AreaSize;
Result.ash[I] := DTM.SubPoints[I - 1].AreaShape;
End; End;
setlength(result.bp, result.l); for i := 0 to result.Count -1 do
for i := 0 to result.l -1 do result.Points[i].bp := false;
result.bp[i] := false;
end; end;
{ TODO: Check if bounds are correct? } procedure NormalizeDTM(var dtm: TMDTM);
function DTMConsistent(const dtm: pdtm): boolean;
var
i: integer;
begin
if dtm.l = 0 then
Exit(False);
if dtm.l <> length(dtm.p) then
Exit(False);
if dtm.l <> length(dtm.c) then
Exit(False);
if dtm.l <> length(dtm.t) then
Exit(False);
if dtm.l <> length(dtm.asz) then
Exit(False);
if dtm.l <> length(dtm.ash) then
Exit(False);
if dtm.l <> length(dtm.bp) then
Exit(False);
for i := 0 to dtm.l-1 do
if dtm.asz[i] < 0 then
Exit(False);
for i := 0 to dtm.l-1 do
if dtm.c[i] < 0 then
Exit(False);
for i := 0 to dtm.l-1 do
if dtm.t[i] < 0 then
Exit(False);
for i := 0 to dtm.l-1 do
if dtm.ash[i] < 0 then
Exit(False);
Exit(True);
end;
procedure NormalizeDTM(var dtm: pdtm);
var var
i:integer; i:integer;
begin begin
// we don't need this check really... if (dtm.count < 1) or ((dtm.Points[0].x = 0) and (dtm.Points[0].y = 0)) then //Already normalized
{if dtm.p[0] = Point(0,0) then //Already normalized exit;
exit;} for i := 1 to dtm.Count - 1 do
for i := 1 to dtm.l - 1 do begin
dtm.p[i] := dtm.p[i] - dtm.p[0]; dtm.Points[i].x := dtm.Points[i].x - dtm.Points[0].x;
dtm.p[0] := dtm.p[0] - dtm.p[0]; //Point(0,0); dtm.Points[i].y := dtm.Points[i].y - dtm.Points[0].y;
end;
dtm.Points[0].x := 0;
dtm.Points[0].y := 0;
end; end;
function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox; function ValidMainPointBox(var dtm: TMDTM; const x1, y1, x2, y2: Integer): TBox;
var var
i: Integer; i: Integer;
@ -240,12 +175,12 @@ begin
FillChar(b, SizeOf(TBox), 0); //Sets all the members to 0 FillChar(b, SizeOf(TBox), 0); //Sets all the members to 0
b.x1 := MaxInt; b.x1 := MaxInt;
b.y1 := MaxInt; b.y1 := MaxInt;
for i := 0 to dtm.l - 1 do for i := 0 to dtm.Count - 1 do
begin begin
b.x1 := min(b.x1, dtm.p[i].x);// - dtm.asz[i]); b.x1 := min(b.x1, dtm.Points[i].x);// - dtm.asz[i]);
b.y1 := min(b.y1, dtm.p[i].y);// - dtm.asz[i]); b.y1 := min(b.y1, dtm.Points[i].y);// - dtm.asz[i]);
b.x2 := max(b.x2, dtm.p[i].x);// + dtm.asz[i]); b.x2 := max(b.x2, dtm.Points[i].x);// + dtm.asz[i]);
b.y2 := max(b.y2, dtm.p[i].y);// + dtm.asz[i]); b.y2 := max(b.y2, dtm.Points[i].y);// + dtm.asz[i]);
end; end;
//writeln(Format('DTM Bounding Box: %d, %d : %d, %d', [b.x1, b.y1,b.x2,b.y2])); //writeln(Format('DTM Bounding Box: %d, %d : %d, %d', [b.x1, b.y1,b.x2,b.y2]));
@ -254,8 +189,19 @@ begin
Result.x2 := x2 - b.x2; Result.x2 := x2 - b.x2;
Result.y2 := y2 - b.y2; Result.y2 := y2 - b.y2;
end; end;
function ValidMainPointBox(const TPA: TPointArray; const x1, y1, x2, y2: Integer): TBox;
var
i: Integer;
b: TBox;
begin
b := GetTPABounds(TPA);
Result.x1 := x1 - b.x1;
Result.y1 := y1 - b.y1;
Result.x2 := x2 - b.x2;
Result.y2 := y2 - b.y2;
end;
function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer; function ValidMainPointBoxRotated(var dtm: TMDTM; const x1, y1, x2, y2: Integer;
const sAngle, eAngle, aStep: Extended): TBox; const sAngle, eAngle, aStep: Extended): TBox;
var var
@ -280,17 +226,17 @@ begin
Result.y2 := y2 - ceil(d); Result.y2 := y2 - ceil(d);
end; end;
function RotateDTM(const dtm: pdtm; angle: extended) : pDTM; {function RotateDTM(const dtm: TMDTM; angle: extended) : TMDTM;
begin begin
if length(dtm.p) = 0 then if DTM.c then
raise Exception.Create('RotateDTM, no points in DTM.'); raise Exception.Create('RotateDTM, no points in DTM.');
result := copydtm(dtm); result := copydtm(dtm);
RotatePoints_(result.p, angle, result.p[0].x, result.p[0].y); RotatePoints_(result.p, angle, result.p[0].x, result.p[0].y);
end; end; }
function copydtm(const dtm: pdtm): pdtm; {function copydtm(const dtm: TMDTM): TMDTM;
begin begin
initdtm(result,dtm.l); iniTSDTM(result,dtm.l);
Move(dtm.p[0], result.p[0], length(dtm.p) * sizeof(Tpoint)); Move(dtm.p[0], result.p[0], length(dtm.p) * sizeof(Tpoint));
Move(dtm.c[0], result.c[0], length(dtm.c) * sizeof(Integer)); Move(dtm.c[0], result.c[0], length(dtm.c) * sizeof(Integer));
Move(dtm.t[0], result.t[0], length(dtm.t) * sizeof(Integer)); Move(dtm.t[0], result.t[0], length(dtm.t) * sizeof(Integer));
@ -298,7 +244,7 @@ begin
Move(dtm.ash[0], result.ash[0], length(dtm.ash) * sizeof(Integer)); Move(dtm.ash[0], result.ash[0], length(dtm.ash) * sizeof(Integer));
Move(dtm.bp[0], result.bp[0], length(dtm.bp) * sizeof(Boolean)); Move(dtm.bp[0], result.bp[0], length(dtm.bp) * sizeof(Boolean));
result.n := 'Copy of ' + dtm.n; result.n := 'Copy of ' + dtm.n;
end; end; }
end. end.

150
Units/MMLCore/finder.pas
View File

@ -30,7 +30,7 @@ interface
{$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks). {$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks).
uses uses
colour_conv, Classes, SysUtils,bitmaps,MufasaBase, MufasaTypes; // Types colour_conv, Classes, SysUtils,bitmaps,MufasaBase,DTM, MufasaTypes; // Types
{ TMFinder Class } { TMFinder Class }
@ -84,10 +84,10 @@ type
function FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, y: Integer; out Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean; function FindBitmapsSpiralTolerance(bitmap: TMufasaBitmap; x, y: Integer; out Points : TPointArray; xs, ys, xe, ye,tolerance: Integer): Boolean;
function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean; function FindDeformedBitmapToleranceIn(bitmap: TMufasaBitmap; out x, y: Integer; xs, ys, xe, ye: Integer; tolerance: Integer; Range: Integer; AllowPartialAccuracy: Boolean; out accuracy: Extended): Boolean;
function FindDTM(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean; function FindDTM(DTM: TMDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
function FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2 : integer; maxToFind: Integer = 0): Boolean; function FindDTMs(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2 : integer; maxToFind: Integer = 0): Boolean;
function FindDTMRotated(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean; function FindDTMRotated(DTM: TMDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
function FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer = 0): Boolean; function FindDTMsRotated(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer = 0): Boolean;
//Donno //Donno
function GetColors(const Coords: TPointArray): TIntegerArray; function GetColors(const Coords: TPointArray): TIntegerArray;
// tol speeds // tol speeds
@ -1914,7 +1914,7 @@ end;
been found at in x, y and result to true. been found at in x, y and result to true.
} }
function TMFinder.FindDTM(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean; function TMFinder.FindDTM(DTM: TMDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
var var
P: TPointArray; P: TPointArray;
begin begin
@ -1929,8 +1929,11 @@ begin
end; end;
//MaxToFind, if it's < 1 it won't stop looking //MaxToFind, if it's < 1 it won't stop looking
function TMFinder.FindDTMs(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean; function TMFinder.FindDTMs(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2, maxToFind: Integer): Boolean;
var var
//Cache DTM stuff
Len : integer; //Len of the points
DPoints : PMDTMPoint; //DTM Points
// Colours of DTMs // Colours of DTMs
clR,clG,clB : array of byte; clR,clG,clB : array of byte;
@ -1973,16 +1976,18 @@ var
begin begin
// Is the area valid? // Is the area valid?
DefaultOperations(x1, y1, x2, y2); DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(dtm) then if not DTM.Valid then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]); raise Exception.CreateFmt('FindDTMs: DTM[%s] is not valid.', [DTM.name]);
// Get the area we should search in for the Main Point. // Get the area we should search in for the Main Point.
MA := ValidMainPointBox(DTM, x1, y1, x2, y2); MA := ValidMainPointBox(DTM, x1, y1, x2, y2);
//Load the DTM-cache variables
Len := dtm.Count;
DPoints:= dtm.PPoints;
// Turn the bp into a more usable array. // Turn the bp into a more usable array.
setlength(goodPoints, dtm.l); setlength(goodPoints, Len);
for i := 0 to dtm.l - 1 do for i := 0 to Len - 1 do
goodPoints[i] := not dtm.bp[i]; goodPoints[i] := not DPoints[i].bp;
// Init data structure b and ch. // Init data structure b and ch.
W := x2 - x1; W := x2 - x1;
@ -1999,17 +2004,17 @@ begin
end; end;
// C = DTM.C // C = DTM.C
SetLength(clR,dtm.l); SetLength(clR,Len);
SetLength(clG,dtm.l); SetLength(clG,Len);
SetLength(clB,dtm.l); SetLength(clB,Len);
for i := 0 to DTM.l - 1 do for i := 0 to Len - 1 do
ColorToRGB(dtm.c[i],clR[i],clG[i],clB[i]); ColorToRGB(DPoints[i].c,clR[i],clG[i],clB[i]);
SetLength(hh,dtm.l); SetLength(hh,Len);
SetLength(ss,dtm.l); SetLength(ss,Len);
SetLength(ll,dtm.l); SetLength(ll,Len);
for i := 0 to DTM.l - 1 do for i := 0 to Len - 1 do
ColorToHSL(dtm.c[i],hh[i],ss[i],ll[i]); ColorToHSL(DPoints[i].c,hh[i],ss[i],ll[i]);
GetToleranceSpeed2Modifiers(hMod, sMod); GetToleranceSpeed2Modifiers(hMod, sMod);
@ -2033,14 +2038,14 @@ begin
for xx := MA.x1 to MA.x2 do for xx := MA.x1 to MA.x2 do
begin begin
//Mainpoint can have area size as well, so we must check that just like any subpoint. //Mainpoint can have area size as well, so we must check that just like any subpoint.
for i := 0 to dtm.l - 1 do for i := 0 to Len - 1 do
begin //change to use other areashapes too. begin //change to use other areashapes too.
Found := false; Found := false;
//With area it can go out of bounds, therefore this max/min check //With area it can go out of bounds, therefore this max/min check
StartX := max(0,xx - dtm.asz[i] + dtm.p[i].x); StartX := max(0,xx - DPoints[i].asz + DPoints[i].x);
StartY := max(0,yy - dtm.asz[i] + dtm.p[i].y); StartY := max(0,yy - DPoints[i].asz + DPoints[i].y);
EndX := Min(MaxX,xx + dtm.asz[i] + dtm.p[i].x); EndX := Min(MaxX,xx + DPoints[i].asz + DPoints[i].x);
EndY := Min(MaxY,yy + dtm.asz[i] + dtm.p[i].y); EndY := Min(MaxY,yy + DPoints[i].asz + DPoints[i].y);
for xxx := StartX to EndX do //The search area for the subpoint for xxx := StartX to EndX do //The search area for the subpoint
begin begin
for yyy := StartY to EndY do for yyy := StartY to EndY do
@ -2050,8 +2055,8 @@ begin
begin begin
// Checking point i now. (Store that we matched it) // Checking point i now. (Store that we matched it)
ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i); 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), DPoints[i].t) 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 if ColorSame(ccts,DPoints[i].t,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); b[xxx][yyy] := b[xxx][yyy] or (1 shl i);
end; end;
@ -2088,7 +2093,7 @@ begin
Result := (pc > 0); Result := (pc > 0);
end; end;
function TMFinder.FindDTMRotated(const DTM: pDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean; function TMFinder.FindDTMRotated(DTM: TMDTM; out x, y: Integer; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: Extended; Alternating : boolean): Boolean;
var var
P: TPointArray; P: TPointArray;
@ -2103,9 +2108,25 @@ begin
Exit(True); Exit(True);
end; end;
function TMFinder.FindDTMsRotated(DTM: pDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer): Boolean; procedure RotPoints_DTM(const P: TPointArray;var RotTPA : TPointArray; const A: Extended);
var var
DTMRot: pDTM; I, L: Integer;
begin
L := High(P);
for I := 0 to L do
begin
RotTPA[I].X := Round(cos(A) * p[i].x - sin(A) * p[i].y);
RotTPA[I].Y := Round(sin(A) * p[i].x + cos(A) * p[i].y);
end;
end;
function TMFinder.FindDTMsRotated(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer): Boolean;
var
//Cached variables
Len : integer;
DPoints : PMDTMPoint;
DTPA : TPointArray;
RotTPA: TPointArray;
// Colours of DTMs // Colours of DTMs
clR,clG,clB : array of byte; clR,clG,clB : array of byte;
@ -2154,14 +2175,17 @@ var
begin begin
// Is the area valid? // Is the area valid?
DefaultOperations(x1, y1, x2, y2); DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(dtm) then if not dtm.Valid then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]); raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.name]);
NormalizeDTM(DTM); NormalizeDTM(DTM);
setlength(goodPoints, DTM.l); Len := DTM.Count;
for i := 0 to DTM.l - 1 do DPoints:= DTM.PPoints;
goodPoints[i] := not DTM.bp[i];
setlength(goodPoints, Len);
for i := 0 to Len - 1 do
goodPoints[i] := not DPoints[i].bp;
MaxX := x2 - x1; MaxX := x2 - x1;
MaxY := y2 - y1; MaxY := y2 - y1;
@ -2180,22 +2204,27 @@ begin
end; end;
// Convert colors to there components // Convert colors to there components
SetLength(clR,DTM.l); SetLength(clR,Len);
SetLength(clG,DTM.l); SetLength(clG,Len);
SetLength(clB,DTM.l); SetLength(clB,Len);
for i := 0 to DTM.l - 1 do for i := 0 to Len - 1 do
ColorToRGB(DTM.c[i],clR[i],clG[i],clB[i]); ColorToRGB(DPoints[i].c,clR[i],clG[i],clB[i]);
//Compiler hints //Compiler hints
SetLength(hh,DTM.l); SetLength(hh,Len);
SetLength(ss,DTM.l); SetLength(ss,Len);
SetLength(ll,DTM.l); SetLength(ll,Len);
for i := 0 to DTM.l - 1 do for i := 0 to Len - 1 do
ColorToHSL(DTM.c[i],hh[i],ss[i],ll[i]); ColorToHSL(DPoints[i].c,hh[i],ss[i],ll[i]);
{We create a kinda 'fake' rotated DTM. This dtm only has points + len, no other crap. {
Since this other 'crap' equals the original DTM, no need to copy that!} When we search for a rotated DTM, everything is the same, except the coordinates..
DTMRot.l := DTM.l; Therefore we create a TPA of the 'original' DTM, containing all the Points.
This then will be used to rotate the points}
SetLength(DTPA,len);
SetLength(RotTPA,len);
for i := 0 to len-1 do
DTPA[i] := Point(DPoints[i].x,DPoints[i].y);
GetToleranceSpeed2Modifiers(hMod, sMod); GetToleranceSpeed2Modifiers(hMod, sMod);
ccts := CTS; ccts := CTS;
@ -2215,12 +2244,11 @@ begin
s := sAngle; s := sAngle;
while s < eAngle do while s < eAngle do
begin begin
// DTMRot := RotateDTM(DTM, s); RotPoints_DTM(DTPA,RotTPA,s);
DTMRot.p := RotatePoints(DTM.p,s,0,0);
//DTMRot now has the same points as the original DTM, just rotated! //DTMRot now has the same points as the original DTM, just rotated!
//The other stuff in the structure doesn't matter, as it's the same as the original DTM.. //The other stuff in the structure doesn't matter, as it's the same as the original DTM..
//So from now on if we want to see what 'point' we're at, use DTMRot.p, for the rest just use the original DTM //So from now on if we want to see what 'point' we're at, use RotTPA, for the rest just use the original DTM
MA := ValidMainPointBox(DTMRot, x1, y1, x2, y2); MA := ValidMainPointBox(RotTPA, x1, y1, x2, y2);
//CD(ClientData) starts at 0,0.. We must adjust the MA, since this is still based on the xs,ys,xe,ye box. //CD(ClientData) starts at 0,0.. We must adjust the MA, since this is still based on the xs,ys,xe,ye box.
MA.x1 := MA.x1 - x1; MA.x1 := MA.x1 - x1;
MA.y1 := MA.y1 - y1; MA.y1 := MA.y1 - y1;
@ -2231,14 +2259,14 @@ begin
for xx := MA.x1 to MA.x2 do for xx := MA.x1 to MA.x2 do
begin begin
//Mainpoint can have area size as well, so we must check that just like any subpoint. //Mainpoint can have area size as well, so we must check that just like any subpoint.
for i := 0 to DTMRot.l - 1 do for i := 0 to Len - 1 do
begin //change to use other areashapes too. begin //change to use other areashapes too.
Found := false; Found := false;
//With area it can go out of bounds, therefore this max/min check //With area it can go out of bounds, therefore this max/min check
StartX := max(0,xx - DTM.asz[i] + DTMRot.p[i].x); StartX := max(0,xx - DPoints[i].asz + RotTPA[i].x);
StartY := max(0,yy - DTM.asz[i] + DTMRot.p[i].y); StartY := max(0,yy - DPoints[i].asz + RotTPA[i].y);
EndX := Min(MaxX,xx + DTM.asz[i] + DTMRot.p[i].x); EndX := Min(MaxX,xx + DPoints[i].asz + RotTPA[i].x);
EndY := Min(MaxY,yy + DTM.asz[i] + DTMRot.p[i].y); EndY := Min(MaxY,yy + DPoints[i].asz + RotTPA[i].y);
for xxx := StartX to EndX do //The search area for the subpoint for xxx := StartX to EndX do //The search area for the subpoint
begin begin
for yyy := StartY to EndY do for yyy := StartY to EndY do
@ -2249,7 +2277,7 @@ begin
// Checking point i now. (Store that we matched it) // Checking point i now. (Store that we matched it)
ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i); ch[xxx][yyy]:= ch[xxx][yyy] or (1 shl i);
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 if ColorSame(ccts,DPoints[i].t,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); b[xxx][yyy] := b[xxx][yyy] or (1 shl i);
end; end;

31
Units/MMLCore/mufasatypes.pas
View File

@ -75,6 +75,7 @@ type
T2DIntArray = array of TIntegerArray; T2DIntArray = array of TIntegerArray;
T2DIntegerArray = T2DIntArray; T2DIntegerArray = T2DIntArray;
TBoolArray = array of boolean; TBoolArray = array of boolean;
TBooleanArray = TBoolArray;
T2DBoolArray = Array of TBoolArray; T2DBoolArray = Array of TBoolArray;
TExtendedArray = Array of Extended; TExtendedArray = Array of Extended;
T2DExtendedArray = Array of Array of Extended; T2DExtendedArray = Array of Array of Extended;
@ -109,29 +110,33 @@ type
{ not points - { not points -
add seperate tpa or boolean array for every point that is to be matched ? add seperate tpa or boolean array for every point that is to be matched ?
} }
{
pDTM = record x,y : Coordinates;
l: Integer; c : Color;
p: TPointArray; t : Tolerance;
c, t, asz, ash: TIntegerArray; Asz: Area size;
bp: Array Of Boolean; bp: Bad Point;
n: String; // DOEN }
TMDTMPoint = record //TMufasaDTMPoint
x,y,c,t,asz : integer;
bp : boolean;
end; end;
PpDTM = ^pDTM; PMDTMPoint = ^TMDTMPoint; //PointerMufasaDTMPoint
TMDTMPointArray = array of TMDTMPoint; //TMufasaDTMPointArray
{ Other DTM Types } { Other DTM Types }
TDTMPointDef = record TSDTMPointDef = record
x, y, Color, Tolerance, AreaSize, AreaShape: integer; x, y, Color, Tolerance, AreaSize, AreaShape: integer;
end; end;
TDTMPointDefArray = Array Of TDTMPointDef; TSDTMPointDefArray = Array Of TSDTMPointDef;
TDTM = record TSDTM = record
MainPoint: TDTMPointDef; MainPoint: TSDTMPointDef;
SubPoints: TDTMPointDefArray; SubPoints: TSDTMPointDefArray;
end; end;
TWritelnProc = procedure(s: string); TWritelnProc = procedure(s: string);