From 486e22d0dbd90257198400f2c03ab46f699f5aeb Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 9 May 2010 14:34:40 +0200 Subject: [PATCH] Fixed bug with open parameter. Added new TPA function. Fixed bug with interpreter where it wouldn't return right in case of a class as result. --- Projects/SAMufasaGUI/testunit.pas | 4 +-- Units/MMLAddon/PSInc/Wrappers/tpa.inc | 15 +++++++---- Units/MMLAddon/PSInc/psexportedmethods.inc | 3 ++- Units/MMLCore/bitmaps.pas | 2 +- Units/MMLCore/tpa.pas | 29 ++++++++++++++++++++++ Units/PascalScript/x86.inc | 13 ++++++---- 6 files changed, 52 insertions(+), 14 deletions(-) diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 48f600d..c18216d 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -1418,13 +1418,13 @@ var ErrorMsg : string; begin DoRun := false; - if Paramcount = 1 then + if (Paramcount = 1) and not (Application.HasOption('open')) then begin if FileExists(ParamStr(1)) then LoadScriptFile(paramstr(1)); end else begin; - ErrorMsg:=Application.CheckOptions('ro:','run open:'); + ErrorMsg:=Application.CheckOptions('ro:',['run','open:']); if ErrorMsg <> '' then mDebugLn(ErrorMSG) else diff --git a/Units/MMLAddon/PSInc/Wrappers/tpa.inc b/Units/MMLAddon/PSInc/Wrappers/tpa.inc index 9db1796..51d2931 100644 --- a/Units/MMLAddon/PSInc/Wrappers/tpa.inc +++ b/Units/MMLAddon/PSInc/Wrappers/tpa.inc @@ -133,6 +133,16 @@ begin FilterPointsPie(points,sd,ed,minr,maxr,mx,my); end; +procedure ps_FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer); extdecl; +begin + FilterPointsDist(points,mindist,maxdist,mx,my); +end; + +procedure ps_FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);extdecl; +begin + FilterPointsLine(points,radial,radius,mx,my); +end; + function ps_GetATPABounds(const ATPA: T2DPointArray): TBox;extdecl; begin result := GetATPABounds(ATPA); @@ -355,11 +365,6 @@ begin Res := ReturnPointsNotInTPA(TotalTPA,box); end; -procedure ps_FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);extdecl; -begin - FilterPointsLine(points,radial,radius,mx,my); -end; - function ps_SameTPA(const aTPA, bTPA: TPointArray): Boolean;extdecl; begin result := SameTPA(atpa,btpa); diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 58f3295..4799a79 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -339,6 +339,8 @@ AddFunction(@ps_SplitTPAEx,'function SplitTPAEx(const arr: TPointArray; w, h: In AddFunction(@ps_SplitTPA,'function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray;'); AddFunction(@ps_FloodFillTPA,'function FloodFillTPA(const TPA : TPointArray) : T2DPointArray;'); AddFunction(@ps_FilterPointsPie,'procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer);'); +AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);'); +AddFunction(@ps_filterpointsdist,'procedure FilterPointsDist(var Points: TPointArray; const MinDist, MaxDist: Extended; Mx, My: Integer);'); AddFunction(@ps_GetATPABounds,'function GetATPABounds(const ATPA: T2DPointArray): TBox;'); AddFunction(@ps_GetTPABounds,'function GetTPABounds(const TPA: TPointArray): TBox;'); AddFunction(@ps_FindTPAinTPA,'function FindTPAinTPA(const SearchTPA, TotalTPA: TPointArray; var Matches: TPointArray): Boolean;'); @@ -386,7 +388,6 @@ AddFunction(@ps_TPAFromBoxWrap,'procedure TPAFromBoxWrap(const Box : TBox; var R AddFunction(@ps_RotatePointsWrap,'procedure RotatePointsWrap(Const P: TPointArray; A, cx, cy: Extended; var Res : TPointArray);'); AddFunction(@ps_FindTPAEdgesWrap,'procedure FindTPAEdgesWrap(const p: TPointArray; var Res : TPointArray);'); AddFunction(@ps_ClearTPAFromTPAWrap,'procedure ClearTPAFromTPAWrap(const arP, ClearPoints: TPointArray; var Res : TPointArray);'); -AddFunction(@ps_FilterPointsLine,'procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer);'); AddFunction(@ps_SameTPA,'function SameTPA(const aTPA, bTPA: TPointArray): Boolean;'); AddFunction(@ps_TPAInATPA,'function TPAInATPA(const TPA: TPointArray;const InATPA: T2DPointArray; var Index: LongInt): Boolean;'); AddFunction(@ps_offsetTPA,'procedure OffsetTPA(var TPA : TPointArray; const Offset : TPoint);'); diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 43e5952..0c52755 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -595,7 +595,7 @@ begin Result := TMufasaBitmap.Create; Result.SetSize(xe-xs+1, ye-ys+1); for i := ys to ye do - Move(self.FData[i * self.w + xs], Result.FData[i-ys],result.Width * SizeOf(TRGB32)); + Move(self.FData[i * self.w + xs], Result.FData[(i-ys) * result.w],result.Width * SizeOf(TRGB32)); end; function TMufasaBitmap.ToTBitmap: TBitmap; diff --git a/Units/MMLCore/tpa.pas b/Units/MMLCore/tpa.pas index b8e4ba9..32669d2 100644 --- a/Units/MMLCore/tpa.pas +++ b/Units/MMLCore/tpa.pas @@ -65,6 +65,7 @@ function SplitTPAEx(const arr: TPointArray; w, h: Integer): T2DPointArray; function SplitTPA(const arr: TPointArray; Dist: Integer): T2DPointArray; function FloodFillTPA(const TPA : TPointArray) : T2DPointArray; procedure FilterPointsPie(var Points: TPointArray; const SD, ED, MinR, MaxR: Extended; Mx, My: Integer); +procedure FilterPointsDist(var Points: TPointArray; const MinDist,MaxDist: Extended; Mx, My: Integer); procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); function RemoveDistTPointArray(x, y, dist: Integer;const ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray; function GetATPABounds(const ATPA: T2DPointArray): TBox; @@ -1101,9 +1102,37 @@ begin Points := G; end; +{/\ + Removes the points that don't have a dist between mindist/maxdist with (mx,my) +/\} + +procedure FilterPointsDist(var Points: TPointArray; const MinDist, + MaxDist: Extended; Mx, My: Integer); +var + c,i,l : integer; + d : extended; + mind,maxd : extended; +begin + l := high(points); + c := 0; + mind := sqr(mindist); + maxd := sqr(maxdist); + for i := 0 to l do + begin + d := sqr(Points[i].x - mx) + sqr(points[i].y - my); + if (d >= mind) and (d <= maxd) then + begin + points[c] := points[i]; + inc(c); + end; + end; + setlength(points,c); +end; + {/\ Removes the points in the TPointArray Points that are not on the line defined by angle, radius and center. /\} + procedure FilterPointsLine(var Points: TPointArray; Radial: Extended; Radius, MX, MY: Integer); var I, Hi, Ind, y: Integer; diff --git a/Units/PascalScript/x86.inc b/Units/PascalScript/x86.inc index df89435..61dc4ec 100644 --- a/Units/PascalScript/x86.inc +++ b/Units/PascalScript/x86.inc @@ -573,13 +573,16 @@ begin btchar,btU8, btS8: tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil); {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil); btClass : + begin {$IFDEF FPC} - tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX, - @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil); - {$ELSE} - tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, - @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil); + if IsConstructor then + tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX, + @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil) + else {$ENDIF} + tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, + @Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil); + end; btu32,bts32{$IFDEF FPC},btArray{$ENDIF}: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil); btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));