moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-22 01:02:17 -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;
begin
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;
function ps_FindDTMs(DTM: Integer; var p: TPointArray; xs, ys, xe, ye: Integer): Boolean; extdecl;
begin
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;
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;
begin
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;
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;
begin
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;
function ps_FindDTMsRotatedAlternating(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray): Boolean; extdecl;
begin
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);
end;
function ps_FindDTMsRotatedSE(DTM: Integer; var Points: TPointArray; xs, ys, xe, ye: Integer; sAngle, eAngle, aStep: Extended; var aFound: T2DExtendedArray): Boolean; extdecl;
begin
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);
end;
procedure ps_SetDTMName(DTM : integer;const name : string);
begin
CurrThread.Client.MDTM.SetDTMName(DTM,name);
CurrThread.Client.MDTMs[DTM].Name := Name;
end;
function ps_DTMFromString(const DTMString: String): Integer; extdecl;
begin
With CurrThread.Client.MDTM do
Result := AddpDTM(StringToDTM(DTMString));
With CurrThread.Client.MDTMs do
Result := AddDTM(StringToDTM(DTMString));
end;
procedure ps_FreeDTM(DTM: Integer); extdecl;
begin
CurrThread.Client.MDTM.FreeDTM(DTM);
CurrThread.Client.MDTMs.FreeDTM(DTM);
end;
function ps_GetDTM(index: Integer) : pDTM; extdecl;
function ps_GetDTM(index: Integer) : TMDTM; extdecl;
begin
result := CurrThread.Client.MDTM.GetDTM(index)^;
result := CurrThread.Client.MDTMs[Index];
end;
function ps_AddDTM(const d: TDTM): Integer; extdecl;
function ps_AddTSDTM(const d: TSDTM): Integer; extdecl;
begin
Result := CurrThread.Client.MDTM.AddDTM(d);
Result := CurrThread.Client.MDTMs.AddDTM(d);
end;
function ps_AddpDTM(const d: pDTM): Integer; extdecl;
function ps_AddDTM(const d: TMDTM): Integer; extdecl;
begin
Result := CurrThread.Client.MDTM.AddpDTM(d);
Result := CurrThread.Client.MDTMs.AddDTM(d);
end;
procedure ps_PrintpDTM(const aDTM : pDTM);extdecl;
procedure ps_PrintDTM(const aDTM : TMDTM);extdecl;
begin
PrintpDTM(aDTM);
PrintDTM(aDTM);
end;
function ps_pDTMToTDTM(Const DTM: pDTM): TDTM;extdecl;
function ps_MDTMToSDTM(Const DTM: TMDTM): TSDTM;extdecl;
begin
result := pDTMToTDTM(DTM);
result := MDTMToSDTM(DTM);
end;
function ps_tDTMTopDTM(Const DTM: TDTM): pDTM;extdecl;
function ps_SDTMToMDTM(Const DTM: TSDTM): TMDTM;extdecl;
begin
result := tDTMTopDTM(DTM);
result := SDTMToMDTM(DTM);
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('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('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;');
x.AddTypes('TSDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
x.AddTypes('TSDTMPointDefArray', 'Array Of TSDTMPointDef;');
x.AddTypes('TSDTM','record MainPoint: TSDTMPointDef; SubPoints: TSDTMPointDefArray; 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('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_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_addDTM, 'function AddDTM(const d: TDTM): Integer;');
AddFunction(@ps_addpDTM, 'function AddpDTM(const d: pDTM): Integer;');
AddFunction(@ps_PrintpDTM, 'procedure PrintpDTM(const tDTM : pDTM);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer) : pDTM');
AddFunction(@ps_pDTMToTDTM, 'function pDTMToTDTM(const DTM: pDTM): TDTM;');
AddFunction(@ps_tDTMTopDTM, 'function tDTMTopDTM(const DTM: TDTM): pDTM;');
AddFunction(@ps_addDTM, 'function AddMDTM(const d: TMDTM): Integer;');
AddFunction(@ps_addDTM, 'function AddDTM(const d: TMDTM): Integer;');
AddFunction(@ps_addTSDTM, 'function AddSDTM(const d: TSDTM): Integer;');
AddFunction(@ps_PrintDTM, 'procedure PrintDTM(const DTM : TMDTM);');
AddFunction(@ps_GetDTM ,'function GetDTM(index: Integer) : TMDTM');
AddFunction(@ps_MDTMToSDTM, 'function MDTMToSDTM(Const DTM: TMDTM): TSDTM;');
AddFunction(@ps_SDTMToMDTM, 'function SDTMToMDTM(Const DTM: TSDTM): TMDTM;');
{maths}
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,
files,
dialogs,
dtm, //Dtms!
uPSR_extctrls, //Runtime-libs
Graphics, //For Graphics types
math, //Maths!
@ -665,242 +666,11 @@ begin
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
end;
{$I PSInc/pscmml.inc}
procedure SIRegister_Mufasa(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;
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;
SIRegister_MML(cl);
end;
procedure TPSThread.OnCompImport(Sender: TObject; x: TPSPascalCompiler);
@ -944,6 +714,45 @@ begin
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;
x: TPSRuntimeClassImporter);
begin

6
Units/MMLCore/client.pas
View File

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

220
Units/MMLCore/dtm.pas
View File

@ -34,20 +34,36 @@ type
{ TMDTM }
{ TMDTM }
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
Client: TObject;
DTMList: Array Of PpDTM;
DTMList: Array Of TMDTM;
FreeSpots: Array Of Integer;
procedure CheckIndex(index : integer);
public
function AddDTM(const d: TDTM): Integer;
function AddpDTM(const d: pDTM): Integer;
function GetDTM(index: Integer) :ppDTM;
function AddDTM(const d: TSDTM): Integer;overload;
function AddDTM(const d: TMDTM): Integer;overload;
function GetDTM(index: Integer) :TMDTM;
procedure FreeDTM(DTM: Integer);
function StringToDTM(const S: String): pDTM;
function DTMToString(const DTM : PDTM) : string;
procedure SetDTMName(DTM: Integer;const S: String);
function StringToDTM(const S: String): TMDTM;
property DTM[Index : integer]: TMDTM read GetDTM; default;
constructor Create(Owner: TObject);
destructor Destroy; override;
end;
@ -63,7 +79,7 @@ uses
constructor TMDTM.Create(Owner: TObject);
constructor TMDTMS.Create(Owner: TObject);
begin
inherited Create;
Self.Client := Owner;
@ -73,7 +89,7 @@ begin
end;
{$DEFINE DTM_DEBUG}
destructor TMDTM.Destroy;
destructor TMDTMS.Destroy;
var
i, j: integer;
b:boolean;
@ -91,8 +107,8 @@ begin
end;
if not b then
begin;
if DTMList[i]^.n <> '' then
WriteStr := WriteStr + DTMList[i]^.n + ', '
if DTMList[i].name <> '' then
WriteStr := WriteStr + DTMList[i].name + ', '
else
WriteStr := WriteStr + inttostr(i) + ', ';
FreeDTM(i);
@ -123,18 +139,15 @@ begin
Result:=StrToInt('$' + HexNum);
end;
function TMDTM.StringToDTM(const S: String): pDTM;
function TMDTMS.StringToDTM(const S: String): TMDTM;
var
b: PBufferByteArray;
Source : String;
DestLen : longword;
i,ii,c : integer;
DPoints : PMDTMPoint;
begin
SetLength(Result.p,0);
SetLength(Result.c,0);
SetLength(Result.t,0);
SetLength(Result.asz,0);
SetLength(Result.ash,0);
Result := TMDTM.Create;
ii := Length(S);
if (ii = 0) or (ii mod 2 <> 0) then
Exit;
@ -148,58 +161,41 @@ begin
if (Destlen mod 36) > 0 then
raise Exception.CreateFmt('Invalid DTM passed to StringToDTM: %s',[s]);
DestLen := DestLen div 36;
SetLength(Result.p,DestLen);
SetLength(Result.c,DestLen);
SetLength(Result.t,DestLen);
SetLength(Result.asz,DestLen);
SetLength(Result.ash,DestLen);
SetLength(Result.bp,DestLen);
Result.Count:= DestLen;
DPoints := result.PPoints;
b := PBufferByteArray(BufferString);
for i := 0 to DestLen - 1 do
begin;
c := i * 36;
Result.p[i].x := PInteger(@b^[c+1])^;
Result.p[i].y := PInteger(@b^[c+5])^;
Result.asz[i] := PInteger(@b^[c+12])^;
Result.ash[i] := PInteger(@b^[c+16])^;
Result.c[i] := PInteger(@b^[c+20])^;
Result.t[i] := PInteger(@b^[c+24])^;
Result.bp[i] := False;
DPoints[i].x := PInteger(@b^[c+1])^;
DPoints[i].y := PInteger(@b^[c+5])^;
DPoints[i].asz := PInteger(@b^[c+12])^;
// Result.ash[i] := PInteger(@b^[c+16])^;
DPoints[i].c := PInteger(@b^[c+20])^;
DPoints[i].t := PInteger(@b^[c+24])^;
DPoints[i].bp := False;
end;
end;
result.l := length(result.p);
end;
function TMDTM.DTMToString(const DTM: PDTM): string;
var
i : integer;
begin
if DTM.l = 0 then
exit;
end;
procedure TMDTM.CheckIndex(index: integer);
procedure TMDTMS.CheckIndex(index: integer);
begin
if (index < 0) or (index >= Length(DTMList)) or (DTMList[Index] = nil) then
raise Exception.CreateFmt('The given DTM Index[%d] doesn''t exist',[index]);
end;
function TMDTM.AddDTM(const d: TDTM): Integer;
function TMDTMS.AddDTM(const d: TSDTM): Integer;
begin
Result := AddpDTM(tDTMTopDTM(d));
Result := AddDTM(SDTMToMDTM(d));
end;
{/\
Adds the given pDTM to the DTM Array, and returns it's index.
/\}
function TMDTM.AddpDTM(const d: pDTM): Integer;
var
NewDTM : PpDTM;
function TMDTMS.AddDTM(const d: TMDTM): Integer;
begin
New(NewDTM);
NewDTM^ := d;
if Length(FreeSpots) > 0 then
begin
@ -211,8 +207,9 @@ begin
SetLength(DTMList, Length(DTMList) + 1);
Result := High(DTMList);
end;
DTMList[Result] := NewDTM;
NormalizeDTM(DTMList[result]^);
DTMList[Result] := d;
DTMList[Result].Index:= Result;
NormalizeDTM(DTMList[result]);
end;
{/\
@ -220,130 +217,55 @@ end;
Returns true is succesfull, false if the dtm does not exist.
/\}
function TMDTM.GetDTM(index: Integer) :ppDTM;
function TMDTMS.GetDTM(index: Integer) :TMDTM;
begin
CheckIndex(index);
result := DTMList[index];
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.
Notes:
Will keep track of not used index, so it is very memory efficient.
/\}
procedure TMDTM.FreeDTM(DTM: Integer);
procedure TMDTMS.FreeDTM(DTM: Integer);
begin
CheckIndex(DTM);
with DTMList[DTM]^ do
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].Free;
DTMList[DTM] := nil;
SetLength(FreeSpots, Length(FreeSpots) + 1);
FreeSpots[High(FreeSpots)] := DTM;
end;
{wat}
// 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.
{ TMDTM }
// I hope it is clear how this will be respresented in computer data
// structures.
// Now, we iterate for i in range(1, n),
// 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)
function TMDTM.GetPointerPoints: PMDTMPoint;
begin
if count < 1 then
result := nil
else
Begin
x := 0;
y := 0;
aFound := 0.0;
Result := False;
end;
end; }
result := @FPoints[0];
end;
{/\
Tries to find the given pDTM. If found will put the point the dtm has
been found at in x, y and result to true.
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.
/\}
procedure TMDTM.SetPointCount(const AValue: integer);
begin
SetLength(FPoints,AValue);
FLen := AValue;
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; }
{/\
Tries to find the given DTM (index). 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.
/\}
{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.
/\}
function TMDTM.Valid: boolean;
begin
result := false;
if Count < 1 then
exit;
result := true;
end;
end.

222
Units/MMLCore/dtmutil.pas
View File

@ -28,21 +28,21 @@ unit dtmutil;
interface
uses
Classes, SysUtils, MufasaTypes;
Classes, SysUtils, dtm,tpa,MufasaTypes;
function pDTMToTDTM(Const DTM: pDTM): TDTM;
function tDTMTopDTM(Const DTM: TDTM): pDTM;
procedure PrintpDTM(const aDTM : pDTM);
function MDTMToSDTM(Const DTM: TMDTM): TSDTM;
function SDTMToMDTM(Const DTM: TSDTM): TMDTM;
procedure PrintDTM(const aDTM : TMDTM);
procedure initdtm(out d: pdtm; len: integer);
function ValidMainPointBox(var dtm: pDTM; const x1, y1, x2, y2: Integer): TBox;
function ValidMainPointBoxRotated(var dtm: pDTM; const x1, y1, x2, y2: Integer;const
{procedure iniTSDTM(out d: TMDTM; len: integer);}
function ValidMainPointBox(var dtm: TMDTM; const x1, y1, x2, y2: Integer): TBox;
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;
function DTMConsistent(const dtm: pdtm): boolean;
procedure NormalizeDTM(var dtm: pdtm);
function RotateDTM(const dtm: pdtm; angle: extended) : pdtm;
function copydtm(const dtm: pdtm): pdtm;
procedure NormalizeDTM(var dtm: TMDTM);
{function RotateDTM(const dtm: TMDTM; angle: extended) : TMDTM;
function copydtm(const dtm: TMDTM): TMDTM; }
const
dtm_Rectangle = 0;
@ -71,164 +71,99 @@ Begin
// I recon it's faster than Point().
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.
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);
procedure PrintDTM(const aDTM : TMDTM);
var
i : integer;
begin;
i := 0;
if aDTM.l = 0 then
if aDTM.count = 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]));
for I := 1 to High(aDTM.p) 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]));
if adtm.Name <> '' then
mDebugLn('Name: ' + aDTM.name);
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.Points) do
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;
function pDTMToTDTM(Const DTM: pDTM): TDTM;
function MDTMToSDTM(Const DTM: TMDTM): TSDTM;
Var
Temp: TDTMPointDef;
Temp: TSDTMPointDef;
I: Integer;
Begin
For I := 0 To 0 Do
Begin
Temp.X := DTM.p[i].x;
Temp.Y := DTM.p[i].y;
Temp.AreaSize := DTM.asz[i];
Temp.AreaShape := DTM.ash[i];
Temp.Color := DTM.c[i];
Temp.Tolerance := DTM.t[i];
Temp.X := DTM.Points[i].x;
Temp.Y := DTM.Points[i].y;
Temp.AreaSize := DTM.Points[i].asz;
Temp.AreaShape := 0;
Temp.Color := DTM.Points[i].c;
Temp.Tolerance := DTM.Points[i].t;
End;
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
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.Y := DTM.p[i].y;
Temp.AreaSize := DTM.asz[i];
Temp.AreaShape := DTM.ash[i];
Temp.Color := DTM.c[i];
Temp.Tolerance := DTM.t[i];
Temp.X := DTM.Points[i].x;
Temp.Y := DTM.Points[i].y;
Temp.AreaSize := DTM.Points[i].asz;
Temp.AreaShape := 0;
Temp.Color := DTM.Points[i].c;
Temp.Tolerance := DTM.Points[i].t;
Result.SubPoints[I - 1] := Temp;
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
I: Integer;
begin
Result.l := 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.Count := Length(DTM.SubPoints) + 1; //The mainpoint is in a different structure
Result.p[0].x := DTM.MainPoint.x;
Result.p[0].y := DTM.MainPoint.y;
Result.c[0] := DTM.MainPoint.Color;
Result.t[0] := DTM.MainPoint.Tolerance;
Result.asz[0] := DTM.MainPoint.AreaSize;
Result.ash[0] := DTM.MainPoint.AreaShape;
Result.Points[0].x := DTM.MainPoint.x;
Result.Points[0].y := DTM.MainPoint.y;
Result.Points[0].c := DTM.MainPoint.Color;
Result.Points[0].t := DTM.MainPoint.Tolerance;
Result.Points[0].asz := DTM.MainPoint.AreaSize;
For I := 1 To Result.l - 1 Do // High + 1 = Length
For I := 1 To Result.Count - 1 Do // High + 1 = Length
Begin
Result.p[I].x := DTM.SubPoints[I - 1].x;
Result.p[I].y := DTM.SubPoints[I - 1].y;
Result.c[I] := DTM.SubPoints[I - 1].Color;
Result.t[I] := DTM.SubPoints[I - 1].Tolerance;
Result.asz[I] := DTM.SubPoints[I - 1].AreaSize;
Result.ash[I] := DTM.SubPoints[I - 1].AreaShape;
Result.Points[I].x := DTM.SubPoints[I - 1].x;
Result.Points[I].y := DTM.SubPoints[I - 1].y;
Result.Points[I].c := DTM.SubPoints[I - 1].Color;
Result.Points[I].t := DTM.SubPoints[I - 1].Tolerance;
Result.Points[I].asz := DTM.SubPoints[I - 1].AreaSize;
End;
setlength(result.bp, result.l);
for i := 0 to result.l -1 do
result.bp[i] := false;
for i := 0 to result.Count -1 do
result.Points[i].bp := false;
end;
{ TODO: Check if bounds are correct? }
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);
procedure NormalizeDTM(var dtm: TMDTM);
var
i:integer;
begin
// we don't need this check really...
{if dtm.p[0] = Point(0,0) then //Already normalized
exit;}
for i := 1 to dtm.l - 1 do
dtm.p[i] := dtm.p[i] - dtm.p[0];
dtm.p[0] := dtm.p[0] - dtm.p[0]; //Point(0,0);
if (dtm.count < 1) or ((dtm.Points[0].x = 0) and (dtm.Points[0].y = 0)) then //Already normalized
exit;
for i := 1 to dtm.Count - 1 do
begin
dtm.Points[i].x := dtm.Points[i].x - dtm.Points[0].x;
dtm.Points[i].y := dtm.Points[i].y - dtm.Points[0].y;
end;
dtm.Points[0].x := 0;
dtm.Points[0].y := 0;
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
i: Integer;
@ -240,12 +175,12 @@ begin
FillChar(b, SizeOf(TBox), 0); //Sets all the members to 0
b.x1 := MaxInt;
b.y1 := MaxInt;
for i := 0 to dtm.l - 1 do
for i := 0 to dtm.Count - 1 do
begin
b.x1 := min(b.x1, dtm.p[i].x);// - dtm.asz[i]);
b.y1 := min(b.y1, dtm.p[i].y);// - dtm.asz[i]);
b.x2 := max(b.x2, dtm.p[i].x);// + dtm.asz[i]);
b.y2 := max(b.y2, dtm.p[i].y);// + dtm.asz[i]);
b.x1 := min(b.x1, dtm.Points[i].x);// - dtm.asz[i]);
b.y1 := min(b.y1, dtm.Points[i].y);// - dtm.asz[i]);
b.x2 := max(b.x2, dtm.Points[i].x);// + dtm.asz[i]);
b.y2 := max(b.y2, dtm.Points[i].y);// + dtm.asz[i]);
end;
//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.y2 := y2 - b.y2;
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;
var
@ -280,17 +226,17 @@ begin
Result.y2 := y2 - ceil(d);
end;
function RotateDTM(const dtm: pdtm; angle: extended) : pDTM;
{function RotateDTM(const dtm: TMDTM; angle: extended) : TMDTM;
begin
if length(dtm.p) = 0 then
if DTM.c then
raise Exception.Create('RotateDTM, no points in DTM.');
result := copydtm(dtm);
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
initdtm(result,dtm.l);
iniTSDTM(result,dtm.l);
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.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.bp[0], result.bp[0], length(dtm.bp) * sizeof(Boolean));
result.n := 'Copy of ' + dtm.n;
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).
uses
colour_conv, Classes, SysUtils,bitmaps,MufasaBase, MufasaTypes; // Types
colour_conv, Classes, SysUtils,bitmaps,MufasaBase,DTM, MufasaTypes; // Types
{ 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 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 FindDTMs(DTM: pDTM; 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 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 FindDTM(DTM: TMDTM; out x, y: Integer; x1, y1, x2, y2: Integer): Boolean;
function FindDTMs(DTM: TMDTM; out Points: TPointArray; x1, y1, x2, y2 : integer; maxToFind: Integer = 0): 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: TMDTM; out Points: TPointArray; x1, y1, x2, y2: Integer; sAngle, eAngle, aStep: Extended; out aFound: T2DExtendedArray;Alternating : boolean; maxToFind: Integer = 0): Boolean;
//Donno
function GetColors(const Coords: TPointArray): TIntegerArray;
// tol speeds
@ -1914,7 +1914,7 @@ end;
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
P: TPointArray;
begin
@ -1929,8 +1929,11 @@ begin
end;
//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
//Cache DTM stuff
Len : integer; //Len of the points
DPoints : PMDTMPoint; //DTM Points
// Colours of DTMs
clR,clG,clB : array of byte;
@ -1973,16 +1976,18 @@ var
begin
// Is the area valid?
DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(dtm) then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]);
if not DTM.Valid then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not valid.', [DTM.name]);
// Get the area we should search in for the Main Point.
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.
setlength(goodPoints, dtm.l);
for i := 0 to dtm.l - 1 do
goodPoints[i] := not dtm.bp[i];
setlength(goodPoints, Len);
for i := 0 to Len - 1 do
goodPoints[i] := not DPoints[i].bp;
// Init data structure b and ch.
W := x2 - x1;
@ -1999,17 +2004,17 @@ begin
end;
// C = DTM.C
SetLength(clR,dtm.l);
SetLength(clG,dtm.l);
SetLength(clB,dtm.l);
for i := 0 to DTM.l - 1 do
ColorToRGB(dtm.c[i],clR[i],clG[i],clB[i]);
SetLength(clR,Len);
SetLength(clG,Len);
SetLength(clB,Len);
for i := 0 to Len - 1 do
ColorToRGB(DPoints[i].c,clR[i],clG[i],clB[i]);
SetLength(hh,dtm.l);
SetLength(ss,dtm.l);
SetLength(ll,dtm.l);
for i := 0 to DTM.l - 1 do
ColorToHSL(dtm.c[i],hh[i],ss[i],ll[i]);
SetLength(hh,Len);
SetLength(ss,Len);
SetLength(ll,Len);
for i := 0 to Len - 1 do
ColorToHSL(DPoints[i].c,hh[i],ss[i],ll[i]);
GetToleranceSpeed2Modifiers(hMod, sMod);
@ -2033,14 +2038,14 @@ begin
for xx := MA.x1 to MA.x2 do
begin
//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.
Found := false;
//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(MaxX,xx + dtm.asz[i] + dtm.p[i].x);
EndY := Min(MaxY,yy + dtm.asz[i] + dtm.p[i].y);
StartX := max(0,xx - DPoints[i].asz + DPoints[i].x);
StartY := max(0,yy - DPoints[i].asz + DPoints[i].y);
EndX := Min(MaxX,xx + DPoints[i].asz + DPoints[i].x);
EndY := Min(MaxY,yy + DPoints[i].asz + DPoints[i].y);
for xxx := StartX to EndX do //The search area for the subpoint
begin
for yyy := StartY to EndY do
@ -2050,8 +2055,8 @@ 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 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 SimilarColors(dtm.c[i], rgbtocolor(cd[yyy][xxx].R, cd[yyy][xxx].G, cd[yyy][xxx].B), DPoints[i].t) 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);
end;
@ -2088,7 +2093,7 @@ begin
Result := (pc > 0);
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
P: TPointArray;
@ -2103,9 +2108,25 @@ begin
Exit(True);
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
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
clR,clG,clB : array of byte;
@ -2154,14 +2175,17 @@ var
begin
// Is the area valid?
DefaultOperations(x1, y1, x2, y2);
if not DTMConsistent(dtm) then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.n]);
if not dtm.Valid then
raise Exception.CreateFmt('FindDTMs: DTM[%s] is not consistent.', [DTM.name]);
NormalizeDTM(DTM);
setlength(goodPoints, DTM.l);
for i := 0 to DTM.l - 1 do
goodPoints[i] := not DTM.bp[i];
Len := DTM.Count;
DPoints:= DTM.PPoints;
setlength(goodPoints, Len);
for i := 0 to Len - 1 do
goodPoints[i] := not DPoints[i].bp;
MaxX := x2 - x1;
MaxY := y2 - y1;
@ -2180,22 +2204,27 @@ begin
end;
// Convert colors to there components
SetLength(clR,DTM.l);
SetLength(clG,DTM.l);
SetLength(clB,DTM.l);
for i := 0 to DTM.l - 1 do
ColorToRGB(DTM.c[i],clR[i],clG[i],clB[i]);
SetLength(clR,Len);
SetLength(clG,Len);
SetLength(clB,Len);
for i := 0 to Len - 1 do
ColorToRGB(DPoints[i].c,clR[i],clG[i],clB[i]);
//Compiler hints
SetLength(hh,DTM.l);
SetLength(ss,DTM.l);
SetLength(ll,DTM.l);
for i := 0 to DTM.l - 1 do
ColorToHSL(DTM.c[i],hh[i],ss[i],ll[i]);
SetLength(hh,Len);
SetLength(ss,Len);
SetLength(ll,Len);
for i := 0 to Len - 1 do
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!}
DTMRot.l := DTM.l;
{
When we search for a rotated DTM, everything is the same, except the coordinates..
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);
ccts := CTS;
@ -2215,12 +2244,11 @@ begin
s := sAngle;
while s < eAngle do
begin
// DTMRot := RotateDTM(DTM, s);
DTMRot.p := RotatePoints(DTM.p,s,0,0);
RotPoints_DTM(DTPA,RotTPA,s);
//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..
//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
MA := ValidMainPointBox(DTMRot, x1, y1, x2, y2);
//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(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.
MA.x1 := MA.x1 - x1;
MA.y1 := MA.y1 - y1;
@ -2231,14 +2259,14 @@ begin
for xx := MA.x1 to MA.x2 do
begin
//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.
Found := false;
//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(MaxX,xx + DTM.asz[i] + DTMRot.p[i].x);
EndY := Min(MaxY,yy + DTM.asz[i] + DTMRot.p[i].y);
StartX := max(0,xx - DPoints[i].asz + RotTPA[i].x);
StartY := max(0,yy - DPoints[i].asz + RotTPA[i].y);
EndX := Min(MaxX,xx + DPoints[i].asz + RotTPA[i].x);
EndY := Min(MaxY,yy + DPoints[i].asz + RotTPA[i].y);
for xxx := StartX to EndX do //The search area for the subpoint
begin
for yyy := StartY to EndY do
@ -2249,7 +2277,7 @@ begin
// Checking point i now. (Store that we matched it)
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);
end;

31
Units/MMLCore/mufasatypes.pas
View File

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