From 1a936b4500aa11f25df5b19e35c6b60c6e74f7bc Mon Sep 17 00:00:00 2001 From: Raymond Date: Wed, 19 May 2010 16:01:01 +0200 Subject: [PATCH] Revised DTM system.. Now DTM is an object, holding an Array of MDTM Points. --- Units/MMLAddon/PSInc/Wrappers/dtm.inc | 44 ++-- Units/MMLAddon/PSInc/pscmml.inc | 97 ++++++++ Units/MMLAddon/PSInc/pscompile.inc | 9 +- Units/MMLAddon/PSInc/psexportedmethods.inc | 13 +- Units/MMLAddon/PSInc/psrmml.inc | 145 +++++++++++ Units/MMLAddon/mmlpsthread.pas | 277 ++++----------------- Units/MMLCore/client.pas | 6 +- Units/MMLCore/dtm.pas | 220 ++++++---------- Units/MMLCore/dtmutil.pas | 222 +++++++---------- Units/MMLCore/finder.pas | 150 ++++++----- Units/MMLCore/mufasatypes.pas | 31 ++- 11 files changed, 584 insertions(+), 630 deletions(-) create mode 100644 Units/MMLAddon/PSInc/pscmml.inc create mode 100644 Units/MMLAddon/PSInc/psrmml.inc diff --git a/Units/MMLAddon/PSInc/Wrappers/dtm.inc b/Units/MMLAddon/PSInc/Wrappers/dtm.inc index c83dc17..63cfa6d 100644 --- a/Units/MMLAddon/PSInc/Wrappers/dtm.inc +++ b/Units/MMLAddon/PSInc/Wrappers/dtm.inc @@ -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; diff --git a/Units/MMLAddon/PSInc/pscmml.inc b/Units/MMLAddon/PSInc/pscmml.inc new file mode 100644 index 0000000..bc2f395 --- /dev/null +++ b/Units/MMLAddon/PSInc/pscmml.inc @@ -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; diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index cdf20ed..3f95937 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/Units/MMLAddon/PSInc/pscompile.inc @@ -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;'); diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 4aa7a99..7ac1e45 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -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'); diff --git a/Units/MMLAddon/PSInc/psrmml.inc b/Units/MMLAddon/PSInc/psrmml.inc new file mode 100644 index 0000000..f5f50a7 --- /dev/null +++ b/Units/MMLAddon/PSInc/psrmml.inc @@ -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; diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index da24629..b797c08 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -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 diff --git a/Units/MMLCore/client.pas b/Units/MMLCore/client.pas index b267faa..c9214af 100644 --- a/Units/MMLCore/client.pas +++ b/Units/MMLCore/client.pas @@ -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; diff --git a/Units/MMLCore/dtm.pas b/Units/MMLCore/dtm.pas index a525c26..4b04acb 100644 --- a/Units/MMLCore/dtm.pas +++ b/Units/MMLCore/dtm.pas @@ -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. diff --git a/Units/MMLCore/dtmutil.pas b/Units/MMLCore/dtmutil.pas index 23dda53..77d8e30 100644 --- a/Units/MMLCore/dtmutil.pas +++ b/Units/MMLCore/dtmutil.pas @@ -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. diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index da8d65a..1c58a64 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -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; diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index cb208b0..87fd35a 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -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);