Fixed bug in Arctan2, added new function ChangeDistPT and ChangeDistTPA.

Projects/Simba/simbaunit.pas

@@ -46,7 +46,7 @@ uses
   CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
 
 const
-  SimbaVersion = 666;
+  SimbaVersion = 668;
 
 type
 

Units/MMLAddon/PSInc/Wrappers/math.inc

@@ -83,9 +83,9 @@ begin
   Result:=Random(Abs(aFrom-aTo))+Min(aTo,AFrom);
 end;
 
-function ps_ArcTan2(x,y : extended) : extended;  extdecl;
+function ps_ArcTan2(y,x : extended) : extended;  extdecl;
 begin
-  result := ArcTan2(x,y);
+  result := ArcTan2(y,x);
 end;
 
 procedure ps_IncEx(var x : integer; increase : integer); extdecl;

Units/MMLAddon/PSInc/Wrappers/tpa.inc

@@ -183,6 +183,16 @@ begin
   result := RotatePoint(p,angle,mx,my);
 end;
 
+function ps_ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;extdecl;
+begin
+  result := ChangeDistPT(pt,mx,my,newdist);
+end;
+
+function ps_ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean; extdecl;
+begin
+  result := ChangeDistTPA(tpa,mx,my,newdist);
+end;
+
 function ps_FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray; extdecl;
 begin
   result := FindGapsTPA(TPA,minpixels);

Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -55,7 +55,7 @@ AddFunction(@ps_min,'function Min(a, b: Integer): Integer;');
 AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;');
 AddFunction(@ps_maxE,'function MaxE(a, b: extended): Extended;');
 AddFunction(@ps_iAbs,'function iAbs(a : integer) : integer;');
-AddFunction(@ps_ArcTan2,'function ArcTan2(x,y : extended) : extended;');
+AddFunction(@ps_ArcTan2,'function ArcTan2(y,x : extended) : extended;');
 AddFunction(@ps_IntToBox,'function IntToBox(xs,ys,xe,ye : integer) : TBox;');
 AddFunction(@ps_IntInBox,'function IntInBox(x, y: Integer; Box: TBox): Boolean;');
 AddFunction(@ps_PointToBox,'function PointToBox(PT1,PT2 : TPoint): TBox;');
@@ -360,6 +360,8 @@ AddFunction(@ps_FindTextTPAinTPA,'function FindTextTPAinTPA(Height : integer;con
 AddFunction(@ps_SortCircleWise,'procedure SortCircleWise(var tpa: TPointArray; const cx, cy, StartDegree: Integer; SortUp, ClockWise: Boolean);');
 AddFunction(@ps_LinearSort,'procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean);');
 AddFunction(@ps_RotatePoint,'function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint;');
+AddFunction(@ps_ChangeDistPT,'function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;');
+AddFunction(@ps_ChangeDistTPA,'function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean;');
 AddFunction(@ps_FindGapsTPA,'function FindGapsTPA(const TPA: TPointArray; MinPixels: Integer): T2DPointArray;');
 AddFunction(@ps_RemoveDistTPointArray,'function RemoveDistTPointArray(x, y, dist: Integer;const  ThePoints: TPointArray; RemoveHigher: Boolean): TPointArray;');
 AddFunction(@ps_CombineTPA,'function CombineTPA(const Ar1, Ar2: TPointArray): TPointArray;');

Units/MMLAddon/mmlpsthread.pas

@@ -218,6 +218,7 @@ uses
   uPSR_extctrls, //Runtime-libs
   Graphics, //For Graphics types
   math, //Maths!
+  mmath, //Real maths!
   strutils,
   tpa, //Tpa stuff
   forms,//Forms

Units/MMLCore/finder.pas

@@ -104,6 +104,7 @@ uses
 //    colour_conv,// For RGBToColor, etc.
     Client, // For the Client Casts.
     math, //min/max
+    mmath,
     tpa, //TPABounds
     dtmutil
     ;

Units/MMLCore/mmath.pas

@@ -31,17 +31,20 @@ interface
 uses
   Classes, SysUtils,MufasaTypes;
 
-function RotatePoints(P: TPointArray; A, cx, cy: Extended): TPointArray;
+function RotatePoints(const P: TPointArray;const A, cx, cy: Extended): TPointArray;
-function RotatePoint(p: TPoint; angle, mx, my: Extended): TPoint;
+function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint;
-
+function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;
+function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean;
 
 implementation
+uses
+  math;
 
 {/\
   Rotates the given points (P) by A (in radians) around the point defined by cx, cy.
 /\}
 
-function RotatePoints(P: TPointArray; A, cx, cy: Extended): TPointArray;
+function RotatePoints(const P: TPointArray;const A, cx, cy: Extended): TPointArray;
 
 var
    I, L: Integer;
@@ -60,12 +63,43 @@ end;
   Rotates the given point (p) by A (in radians) around the point defined by cx, cy.
 /\}
 
-function RotatePoint(p: TPoint; angle, mx, my: Extended): TPoint;
+function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint;
 
 begin
   Result.X := Round(mx + cos(angle) * (p.x - mx) - sin(angle) * (p.y - my));
   Result.Y := Round(my + sin(angle) * (p.x - mx) + cos(angle) * (p.y- my));
 end;
 
+function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint;
+var
+  angle : extended;
+begin
+  angle := ArcTan2(pt.y-my,pt.x-mx);
+  result.y := round(sin(angle) * newdist) + mx;
+  result.x := round(cos(angle) * newdist) + my;
+end;
+
+function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean;
+var
+  angle : extended;
+  i : integer;
+begin
+  result := false;
+  if length(TPA) < 1 then
+    exit;
+  result := true;
+  try
+    for i := high(TPA) downto 0 do
+    begin
+      angle := ArcTan2(TPA[i].y-my,TPA[i].x-mx);
+      TPA[i].y := round(sin(angle) * newdist) + mx;
+      TPA[i].x := round(cos(angle) * newdist) + my;
+    end;
+  except
+    result := false;
+  end;
+
+end;
+
 end.
 

Units/MMLCore/tpa.pas

@@ -79,8 +79,6 @@ procedure LinearSort(var tpa: TPointArray; cx, cy, sd: Integer; SortUp: Boolean)
 function MergeATPA(const ATPA : T2DPointArray)  : TPointArray;
 procedure AppendTPA(var TPA : TPointArray; const ToAppend : TPointArray);
 function TPAFromBox(const Box : TBox) : TPointArray;
-Function RotatePoints(Const P: TPointArray; A, cx, cy: Extended): TPointArray ;
-Function RotatePoint(Const p: TPoint; angle, mx, my: Extended): TPoint; inline;
 function FindTPAEdges(const p: TPointArray): TPointArray;
 function PointInTPA(const p: TPoint;const arP: TPointArray): Boolean;
 function ClearTPAFromTPA(const arP, ClearPoints: TPointArray): TPointArray;
@@ -100,7 +98,7 @@ procedure OffsetATPA(var ATPA : T2DPointArray; const Offset : TPoint);
 implementation
 
 uses
-  math;
+  math,mmath;