diff --git a/DocGen/docgen.simba b/DocGen/docgen.simba
index c33505be7..4e8463a1b 100644
--- a/DocGen/docgen.simba
+++ b/DocGen/docgen.simba
@@ -185,6 +185,7 @@ begin
ParseSourceFile('simba.import_box', 'TBox' );
ParseSourceFile('simba.import_boxarray', 'TBoxArray' );
ParseSourceFile('simba.import_quad', 'TQuad' );
+ ParseSourceFile('simba.import_circle', 'TCircle' );
ParseSourceFile('simba.import_windowhandle', 'TWindowHandle' );
ParseSourceFile('simba.import_debugimage', 'Debug Image' );
ParseSourceFile('simba.import_variant', 'Variant' );
diff --git a/Source/Simba.lpi b/Source/Simba.lpi
index 2aa8feac6..a6ce69da9 100644
--- a/Source/Simba.lpi
+++ b/Source/Simba.lpi
@@ -340,7 +340,7 @@
-
+
@@ -998,6 +998,14 @@
+
+
+
+
+
+
+
+
diff --git a/Source/forms/simba.functionlistform.pas b/Source/forms/simba.functionlistform.pas
index 6b240b80b..49dcfbc33 100644
--- a/Source/forms/simba.functionlistform.pas
+++ b/Source/forms/simba.functionlistform.pas
@@ -164,6 +164,8 @@ function GetURL(const Section: String): String;
'Dialogs': Result := 'https://villavu.github.io/Simba/Dialogs.html';
'DTM': Result := 'https://villavu.github.io/Simba/DTM.html';
'System': Result := 'https://villavu.github.io/Simba/System.html';
+ 'TCircle': Result := 'https://villavu.github.io/Simba/TCircle.html';
+ 'DateTime': Result := 'https://villavu.github.io/Simba/DateTime.html';
end;
end;
diff --git a/Source/script/imports/simba/simba.import_circle.pas b/Source/script/imports/simba/simba.import_circle.pas
new file mode 100644
index 000000000..9ba73c7b3
--- /dev/null
+++ b/Source/script/imports/simba/simba.import_circle.pas
@@ -0,0 +1,228 @@
+{
+ Author: Raymond van Venetië and Merlijn Wajer
+ Project: Simba (https://github.com/MerlijnWajer/Simba)
+ License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
+}
+unit simba.import_circle;
+
+{$i simba.inc}
+
+interface
+
+uses
+ Classes, SysUtils,
+ simba.mufasatypes, simba.script_compiler;
+
+procedure ImportCircle(Compiler: TSimbaScript_Compiler);
+
+implementation
+
+uses
+ lptypes,
+ simba.circle;
+
+(*
+TCircle
+=======
+Record that contains center point and radius.
+*)
+
+(*
+TCircle.Create
+~~~~~~~~~~~~~~
+> function TCircle.Create(ACenter: TPoint; ARadius: Integer): TCircle; static;
+*)
+procedure _LapeCircle_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PCircle(Result)^ := TCircle.Create(PPoint(Params^[0])^, PInteger(Params^[1])^);
+end;
+
+(*
+TCircle.CreateFromPoints
+~~~~~~~~~~~~~~~~~~~~~~~~
+> function CreateFromPoints(Points: TPointArray): TCircle; static;
+*)
+procedure _LapeCircle_CreateFromPoints(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PCircle(Result)^ := TCircle.CreateFromPoints(PPointArray(Params^[0])^);
+end;
+
+(*
+TCircle.ToTPA
+~~~~~~~~~~~~~
+> function TCircle.ToTPA(Filled: Boolean): TPointArray;
+*)
+procedure _LapeCircle_ToTPA(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PPointArray(Result)^ := PCircle(Params^[0])^.ToTPA(PBoolean(Params^[1])^);
+end;
+
+(*
+TCircle.Bounds
+~~~~~~~~~~~~~~
+> function TCircle.Bounds: TBox;
+*)
+procedure _LapeCircle_Bounds(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBox(Result)^ := PCircle(Params^[0])^.Bounds();
+end;
+
+(*
+TCircle.Contains
+~~~~~~~~~~~~~~~~
+> function TCircle.Contains(P: TPoint): Boolean
+*)
+procedure _LapeCircle_Contains(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBoolean(Result)^ := PCircle(Params^[0])^.Contains(PPoint(Params^[1])^);
+end;
+
+(*
+TCircle.PointAtDegrees
+~~~~~~~~~~~~~~~~~~~~~~
+> function TCircle.PointAtDegrees(Degrees: Double): TPoint;
+*)
+procedure _LapeCircle_PointAtDegrees(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PPoint(Result)^ := PCircle(Params^[0])^.PointAtDegrees(PDouble(Params^[1])^);
+end;
+
+(*
+TCircle.RandomPoint
+~~~~~~~~~~~~~~~~~~~
+> function TCircle.RandomPoint: TPoint;
+
+Returns a completely random point in the circle.
+*)
+procedure _LapeCircle_RandomPoint(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PPoint(Result)^ := PCircle(Params^[0])^.RandomPoint();
+end;
+
+(*
+TCircle.RandomPointCenter
+~~~~~~~~~~~~~~~~~~~~~~~~~
+> function TCircle.RandomPointCenter: TPoint;
+
+Returns a random point in the circle which is weighted torwards the circle's center.
+*)
+procedure _LapeCircle_RandomPointCenter(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PPoint(Result)^ := PCircle(Params^[0])^.RandomPointCenter();
+end;
+
+(*
+TCircle.Circumference
+~~~~~~~~~~~~~~~~~~~~~
+> function TCircle.Circumference: Double;
+
+Returns the distance around the outside of a circle.
+*)
+procedure _LapeCircle_Circumference(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PDouble(Result)^ := PCircle(Params^[0])^.Circumference();
+end;
+
+(*
+TCircle.Area
+~~~~~~~~~~~~
+> function TCircle.Area: Double;
+
+Returns the area the circle covers.
+*)
+procedure _LapeCircle_Area(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PDouble(Result)^ := PCircle(Params^[0])^.Area();
+end;
+
+(*
+TCircle.Area
+~~~~~~~~~~~~
+> function TCircle.Area: Double;
+
+Returns the area the circle covers.
+*)
+procedure _LapeCircle_Expand(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PCircle(Result)^ := PCircle(Params^[0])^.Expand(PInteger(Params^[1])^);
+end;
+
+(*
+TCircle.Area
+~~~~~~~~~~~~
+> function TCircle.Area: Double;
+
+Returns the area the circle covers.
+*)
+procedure _LapeCircle_Offset(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PCircle(Result)^ := PCircle(Params^[0])^.Offset(PPoint(Params^[1])^);
+end;
+
+(*
+TCircle.Extract
+~~~~~~~~~~~~~~~
+> function TCircle.Extract(Points: TPointArray): TPointArray;
+
+Returns the points that **are** in the circle.
+*)
+procedure _LapeCircle_Extract(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PPointArray(Result)^ := PCircle(Params^[0])^.Extract(PPointArray(Params^[1])^);
+end;
+
+(*
+TCircle.Exclude
+~~~~~~~~~~~~~~~
+> function TCircle.Exclude(Points: TPointArray): TPointArray;
+
+Returns the points that are not inside the circle.
+*)
+procedure _LapeCircle_Exclude(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PPointArray(Result)^ := PCircle(Params^[0])^.Exclude(PPointArray(Params^[1])^);
+end;
+
+(*
+in
+~~
+> operator in(Left: TPoint; Right: TCircle): Boolean;
+*)
+procedure _LapePoint_IN_Cicle(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBoolean(Result)^ := PPoint(Params^[0])^ in PCircle(Params^[1])^;
+end;
+
+procedure ImportCircle(Compiler: TSimbaScript_Compiler);
+begin
+ with Compiler do
+ begin
+ ImportingSection := 'TCircle';
+
+ addGlobalType('record Center: TPoint; Radius: Integer; end;', 'TCircle');
+
+ addGlobalFunc('function TCircle.Create(ACenter: TPoint; ARadius: Integer): TCircle; static; overload', @_LapeCircle_Create);
+ addGlobalFunc('function TCircle.CreateFromPoints(Points: TPointArray): TCircle; static; overload', @_LapeCircle_CreateFromPoints);
+
+ addGlobalFunc('function TCircle.ToTPA(Filled: Boolean): TPointArray', @_LapeCircle_ToTPA);
+ addGlobalFunc('function TCircle.Bounds: TBox', @_LapeCircle_Bounds);
+ addGlobalFunc('function TCircle.Contains(P: TPoint): Boolean', @_LapeCircle_Contains);
+ addGlobalFunc('function TCircle.PointAtDegrees(Degrees: Double): TPoint;', @_LapeCircle_PointAtDegrees);
+
+ addGlobalFunc('function TCircle.RandomPoint: TPoint', @_LapeCircle_RandomPoint);
+ addGlobalFunc('function TCircle.RandomPointCenter: TPoint', @_LapeCircle_RandomPointCenter);
+
+ addGlobalFunc('function TCircle.Circumference: Double', @_LapeCircle_Circumference);
+ addGlobalFunc('function TCircle.Area: Double', @_LapeCircle_Area);
+ addGlobalFunc('function TCircle.Expand(Amount: Integer): TCircle', @_LapeCircle_Expand);
+ addGlobalFunc('function TCircle.Offset(P: TPoint): TCircle', @_LapeCircle_Offset);
+ addGlobalFunc('function TCircle.Extract(Points: TPointArray): TPointArray', @_LapeCircle_Extract);
+ addGlobalFunc('function TCircle.Exclude(Points: TPointArray): TPointArray', @_LapeCircle_Exclude);
+
+ addGlobalFunc('operator in(Left: TPoint; Right: TCircle): Boolean;', @_LapePoint_IN_Cicle);
+
+ ImportingSection := '';
+ end;
+end;
+
+end.
diff --git a/Source/script/imports/simba/simba.import_quad.pas b/Source/script/imports/simba/simba.import_quad.pas
index 1b1865fcf..fbbc6cba5 100644
--- a/Source/script/imports/simba/simba.import_quad.pas
+++ b/Source/script/imports/simba/simba.import_quad.pas
@@ -1,3 +1,8 @@
+{
+ Author: Raymond van Venetië and Merlijn Wajer
+ Project: Simba (https://github.com/MerlijnWajer/Simba)
+ License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
+}
unit simba.import_quad;
{$i simba.inc}
@@ -291,4 +296,4 @@ procedure ImportQuad(Compiler: TSimbaScript_Compiler);
end;
end;
-end.
\ No newline at end of file
+end.
diff --git a/Source/script/imports/simba/simba.import_tpa.pas b/Source/script/imports/simba/simba.import_tpa.pas
index c738ecb12..3901ce28f 100644
--- a/Source/script/imports/simba/simba.import_tpa.pas
+++ b/Source/script/imports/simba/simba.import_tpa.pas
@@ -1,3 +1,8 @@
+{
+ Author: Raymond van Venetië and Merlijn Wajer
+ Project: Simba (https://github.com/MerlijnWajer/Simba)
+ License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
+}
unit simba.import_tpa;
{$i simba.inc}
@@ -14,7 +19,7 @@ implementation
uses
lptypes,
- simba.tpa, simba.geometry,
+ simba.tpa, simba.circle, simba.geometry,
simba.algo_difference, simba.algo_intersection, simba.algo_symmetricDifference;
(*
@@ -637,6 +642,16 @@ procedure _LapeTPAMinAreaRect(const Params: PParamArray; const Result: Pointer);
PQuad(Result)^ := PPointArray(Params^[0])^.MinAreaRect();
end;
+(*
+TPointArray.MinAreaCircle
+~~~~~~~~~~~~~~~~~~~~~~~~~
+> function TPointArray.MinAreaCircle: TCircle;
+*)
+procedure _LapeTPAMinAreaCircle(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PCircle(Result)^ := PPointArray(Params^[0])^.MinAreaCircle();
+end;
+
(*
TPointArray.Erode
~~~~~~~~~~~~~~~~~
@@ -763,6 +778,7 @@ procedure ImportTPA(Compiler: TSimbaScript_Compiler);
addGlobalFunc('function TPointArray.Extremes: TPointArray', @_LapeTPAExtremes);
addGlobalFunc('function TPointArray.Bounds: TBox; overload', @_LapeTPABounds);
addGlobalFunc('function TPointArray.MinAreaRect: TQuad', @_LapeTPAMinAreaRect);
+ addGlobalFunc('function TPointArray.MinAreaCircle: TCircle', @_LapeTPAMinAreaCircle);
addGlobalFunc('function TPointArray.Mean: TPoint; overload', @_LapeTPAMean);
addGlobalFunc('function TPointArray.Connect: TPointArray', @_LapeTPAConnect);
diff --git a/Source/script/simba.compiler_dump.pas b/Source/script/simba.compiler_dump.pas
index 49ad2924e..ea3e9418a 100644
--- a/Source/script/simba.compiler_dump.pas
+++ b/Source/script/simba.compiler_dump.pas
@@ -319,15 +319,24 @@ procedure TSimbaCompilerDump.DumpToFile(FileName: String);
// Move lape stuff to better sections
Move('function Random(min, max: Int64): Int64;', 'Math', 'Random');
- Move('function Random(min, max: Extended): Extended', 'Math', 'Random');
+ Move('function Random(min, max: Double): Double', 'Math', 'Random');
Move('function Random(l: Int64): Int64', 'Math', 'Random');
- Move('function Random: Extended', 'Math', 'Random');
+ Move('function Random: Double', 'Math', 'Random');
Move('procedure Randomize', 'Math', 'Random');
Move('var RandSeed', 'Math', 'Random');
Move('function GetTickCount: UInt64', 'DateTime', 'Timing');
Move('procedure Sleep(MilliSeconds: UInt32);', 'DateTime', 'Timing');
+ Move('type TBox = record X1, Y1, X2, Y2: Integer; end;', 'System', 'TBox');
+ Move('type TBoxArray = array of TBox;', 'System', 'TBox');
+
+ Move('type TQuad = record Top, Right, Bottom, Left: TPoint; end;', 'System', 'TQuad');
+ Move('type TQuadArray = array of TQuad;', 'System', 'TQuad');
+
+ Move('type TPoint = record X, Y: Integer; end;', 'System', 'TPoint');
+ Move('type TPointArray = array of TPoint;', 'System', 'TPointArray');
+
with TStringList.Create() do
try
LineBreak := #0;
diff --git a/Source/script/simba.script_imports.pas b/Source/script/simba.script_imports.pas
index 3abf2b842..e071f33fb 100644
--- a/Source/script/simba.script_imports.pas
+++ b/Source/script/simba.script_imports.pas
@@ -21,6 +21,7 @@ implementation
simba.import_system, simba.import_colormath,
simba.import_matrix, simba.import_windowhandle,
simba.import_quad, simba.import_box, simba.import_boxarray, simba.import_point,
+ simba.import_circle,
// LCL
simba.import_lcl_system, simba.import_lcl_graphics, simba.import_lcl_controls,
@@ -47,6 +48,7 @@ procedure AddSimbaImports(Compiler: TSimbaScript_Compiler);
ImportMatrix(Compiler);
ImportWindowHandle(Compiler);
ImportQuad(Compiler);
+ ImportCircle(Compiler);
ImportBox(Compiler);
ImportBoxArray(Compiler);
ImportPoint(Compiler);
diff --git a/Source/simba.circle.pas b/Source/simba.circle.pas
new file mode 100644
index 000000000..9bfe7cdd4
--- /dev/null
+++ b/Source/simba.circle.pas
@@ -0,0 +1,164 @@
+{
+ Author: Raymond van Venetië and Merlijn Wajer
+ Project: Simba (https://github.com/MerlijnWajer/Simba)
+ License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
+}
+unit simba.circle;
+
+{$i simba.inc}
+
+interface
+
+uses
+ Classes, SysUtils,
+ simba.mufasatypes;
+
+type
+ PCircle = ^TCircle;
+ TCircle = record
+ Center: TPoint;
+ Radius: Integer;
+ end;
+
+ TCircleHelper = type helper for TCircle
+ public const
+ DEFAULT_VALUE: TCircle = (Center: (X: 0; Y: 0); Radius: 0);
+ public
+ class function Create(ACenter: TPoint; ARadius: Integer): TCircle; static;
+ class function CreateFromPoints(Points: TPointArray): TCircle; static;
+
+ function Bounds: TBox;
+ function ToTPA(Filled: Boolean): TPointArray;
+ function Contains(const P: TPoint): Boolean; inline;
+ function PointAtDegrees(Degrees: Double): TPoint;
+ function Circumference: Double;
+ function Area: Double;
+ function Expand(Amount: Integer): TCircle;
+ function Offset(P: TPoint): TCircle;
+ function Extract(Points: TPointArray): TPointArray;
+ function Exclude(Points: TPointArray): TPointArray;
+ function RandomPoint: TPoint;
+ function RandomPointCenter: TPoint;
+ end;
+
+ operator in(const P: TPoint; const Circle: TCircle): Boolean;
+
+implementation
+
+uses
+ Math,
+ simba.tpa, simba.random, simba.overallocatearray;
+
+class function TCircleHelper.Create(ACenter: TPoint; ARadius: Integer): TCircle;
+begin
+ Result.Center := ACenter;
+ Result.Radius := ARadius;
+end;
+
+class function TCircleHelper.CreateFromPoints(Points: TPointArray): TCircle;
+begin
+ Result := Points.MinAreaCircle();
+end;
+
+function TCircleHelper.Bounds: TBox;
+begin
+ Result := TBox.Create(Center, Radius, Radius);
+end;
+
+function TCircleHelper.ToTPA(Filled: Boolean): TPointArray;
+begin
+ Result := TPointArray.CreateFromCircle(Center, Radius, Filled);
+end;
+
+function TCircleHelper.Contains(const P: TPoint): Boolean;
+begin
+ Result := Hypot(P.X - Self.Center.X, P.Y - Self.Center.Y) <= Self.Radius;
+end;
+
+function TCircleHelper.PointAtDegrees(Degrees: Double): TPoint;
+begin
+ Result.X := Round(Self.Radius * Cos(DegToRad(Degrees) - PI/2)) + Self.Center.X;
+ Result.Y := Round(Self.Radius * Sin(DegToRad(Degrees) - PI/2)) + Self.Center.Y;
+end;
+
+function TCircleHelper.Circumference: Double;
+begin
+ Result := 2 * PI * Self.Radius;
+end;
+
+function TCircleHelper.Area: Double;
+begin
+ Result := PI * Sqr(Self.Radius);
+end;
+
+function TCircleHelper.Expand(Amount: Integer): TCircle;
+begin
+ Result := Self;
+ Result.Radius += Amount;
+end;
+
+function TCircleHelper.Offset(P: TPoint): TCircle;
+begin
+ Result := Self;
+ Result.Center := Result.Center.Offset(P);
+end;
+
+function TCircleHelper.Extract(Points: TPointArray): TPointArray;
+var
+ I: Integer;
+ Buffer: TSimbaPointBuffer;
+begin
+ Buffer.Init(Length(Points));
+ for I := 0 to High(Points) do
+ if Contains(Points[I]) then
+ Buffer.Add(Points[I]);
+
+ Result := Buffer.Trim();
+end;
+
+function TCircleHelper.Exclude(Points: TPointArray): TPointArray;
+var
+ I: Integer;
+ Buffer: TSimbaPointBuffer;
+begin
+ Buffer.Init(Length(Points));
+ for I := 0 to High(Points) do
+ if not Contains(Points[I]) then
+ Buffer.Add(Points[I]);
+
+ Result := Buffer.Trim();
+end;
+
+function TCircleHelper.RandomPoint: TPoint;
+var
+ R, Theta, SinValue, CosValue: Double;
+begin
+ R := Radius * Sqrt(Random());
+ Theta := Random() * 2 * PI;
+
+ SinCos(Theta, SinValue, CosValue);
+
+ Result.X := Center.X + Round(R * CosValue);
+ Result.Y := Center.X + Round(R * SinValue);
+end;
+
+function TCircleHelper.RandomPointCenter: TPoint;
+var
+ R, Theta, SinValue, CosValue: Double;
+begin
+ R := Radius * Sqrt(RandomLeft(0.0, 1.0));
+ Theta := Random() * 2 * PI;
+
+ SinCos(Theta, SinValue, CosValue);
+
+ Result.X := Center.X + Round(R * CosValue);
+ Result.Y := Center.X + Round(R * SinValue);
+end;
+
+operator in(const P: TPoint; const Circle: TCircle): Boolean;
+begin
+ Result := Circle.Contains(P);
+end;
+
+end.
+
diff --git a/Source/simba.inc b/Source/simba.inc
index 96b49107b..0585358ce 100644
--- a/Source/simba.inc
+++ b/Source/simba.inc
@@ -9,7 +9,7 @@
{$DEFINE SIMBA_HAS_DEBUGINFO}
{$ELSE}
{$IFDEF SIMBA_MAX_OPTIMIZATION} // O4 can do "unsafe" optimizations so this is not globally enabled.
- {$OPTIMIZATION LEVEL4}
+ {.$OPTIMIZATION LEVEL4}
{$ENDIF}
{$ENDIF}
diff --git a/Source/simba.mufasatypes.pas b/Source/simba.mufasatypes.pas
index 6e733b830..951b9f4d0 100644
--- a/Source/simba.mufasatypes.pas
+++ b/Source/simba.mufasatypes.pas
@@ -392,6 +392,9 @@ function Max(const A, B: Single): Single; inline; overload;
function Min(const A, B: Double): Double; inline; overload;
function Max(const A, B: Double): Double; inline; overload;
+function Min(const A, B, C: Integer): Integer; inline; overload;
+function Max(const A, B, C: Integer): Integer; inline; overload;
+
procedure Swap(var A, B: Byte); overload;
procedure Swap(var A, B: Integer); overload;
procedure Swap(var A, B: Single); overload;
@@ -632,6 +635,34 @@ function Max(const A, B: Double): Double;
Result := B;
end;
+function Min(const A, B, C: Integer): Integer;
+begin
+ if A < B then
+ if C < A then
+ Result := C
+ else
+ Result := A
+ else
+ if C < B then
+ Result := C
+ else
+ Result := B;
+end;
+
+function Max(const A, B, C: Integer): Integer;
+begin
+ if A > B then
+ if C > A then
+ Result := C
+ else
+ Result := A
+ else
+ if C > B then
+ Result := C
+ else
+ Result := B;
+end;
+
procedure Swap(var A, B: Byte);
begin
specialize Swap(A, B);
diff --git a/Source/simba.threading.pas b/Source/simba.threading.pas
index da46fc15b..77cae96f0 100644
--- a/Source/simba.threading.pas
+++ b/Source/simba.threading.pas
@@ -1,3 +1,8 @@
+{
+ Author: Raymond van Venetië and Merlijn Wajer
+ Project: Simba (https://github.com/MerlijnWajer/Simba)
+ License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
+}
unit simba.threading;
{$i simba.inc}
diff --git a/Source/simba.tpa.pas b/Source/simba.tpa.pas
index f32a2747d..d2550b689 100644
--- a/Source/simba.tpa.pas
+++ b/Source/simba.tpa.pas
@@ -14,6 +14,7 @@
- Border
- Skeleton
- MinAreaRect
+ - MinAreaCircle
- Erode
- Grow
- RotateEx
@@ -36,7 +37,7 @@ interface
uses
Classes, SysUtils,
- simba.mufasatypes;
+ simba.mufasatypes, simba.circle;
type
TPointArrayHelper = type helper for TPointArray
@@ -67,6 +68,7 @@ interface
function Mean: TPoint;
function MinAreaRect: TQuad;
+ function MinAreaCircle: TCircle;
function Bounds: TBox;
function Area: Double;
@@ -2137,7 +2139,7 @@ function TPointArrayHelper.DistanceTransform: TSingleMatrix;
function EucSep(const i,j, ii,jj:Int32): Int32; inline;
begin
- Result := Round((sqr(j) - sqr(i) + sqr(jj) - sqr(ii))/(2*(j-i)));
+ Result := Round((sqr(j) - sqr(i) + sqr(jj) - sqr(ii)) / (2*(j-i)));
end;
function Transform(const binIm:TIntegerArray; m,n:Int32): TSingleMatrix;
@@ -2209,7 +2211,7 @@ function TPointArrayHelper.DistanceTransform: TSingleMatrix;
var
Data:TIntegerArray;
- w,h,n,i:Int32;
+ w,h,i:Int32;
B:TBox;
begin
Result := nil;
@@ -2228,5 +2230,138 @@ function TPointArrayHelper.DistanceTransform: TSingleMatrix;
Result := Transform(data,w,h);
end;
+function TPointArrayHelper.MinAreaCircle: TCircle;
+var
+ Points: TPointArray;
+
+ function NewCircle2(const p0, p1: TPoint): TCircle;
+ begin
+ Result.Center.X := (p0.x + p1.x) div 2;
+ Result.Center.Y := (p0.y + p1.y) div 2;
+ Result.Radius := Ceil(Max(
+ Hypot(Result.Center.X - p0.X, Result.Center.Y - p0.Y),
+ Hypot(Result.Center.X - p1.X, Result.Center.Y - p1.Y)
+ ));
+ end;
+
+ function NewCircle3(const p0, p1, p2: TPoint): TCircle;
+ var
+ d,ax,ay,bx,by,cx,cy,ox,oy,x,y,ra,rb,rc: Integer;
+ begin
+ // Mathematical algorithm from Wikipedia: Circumscribed circle
+ ax := p0.x; ay := p0.y;
+ bx := p1.x; by := p1.y;
+ cx := p2.x; cy := p2.y;
+ ox := (Min(Min(ax, bx), cx) + Max(Max(ax, bx), cx)) div 2;
+ oy := (Min(Min(ay, by), cy) + Max(Max(ay, by), cy)) div 2;
+ ax -= ox; ay -= oy;
+ bx -= ox; by -= oy;
+ cx -= ox; cy -= oy;
+ d := (ax * (by - cy) + bx * (cy - ay) + cx * (ay - by)) * 2;
+
+ if (d <> 0) then
+ begin
+ x := ox + ((ax * ax + ay * ay) * (by - cy) + (bx * bx + by * by) * (cy - ay) + (cx * cx + cy * cy) * (ay - by)) div d;
+ y := oy + ((ax * ax + ay * ay) * (cx - bx) + (bx * bx + by * by) * (ax - cx) + (cx * cx + cy * cy) * (bx - ax)) div d;
+ ra := Ceil(Hypot(x-p0.x, y-p0.y));
+ rb := Ceil(Hypot(x-p1.x, y-p1.y));
+ rc := Ceil(Hypot(x-p2.x, y-p2.y));
+
+ Result.Center.X := x;
+ Result.Center.Y := y;
+ Result.Radius := Max(ra, rb, rc);
+ end else
+ Result := TCircle.DEFAULT_VALUE;
+ end;
+
+ // Two boundary Points known
+ function makeCircleTwoPoints(stop: Integer; P, Q: TPoint): TCircle;
+ var
+ I: Integer;
+ c, circ, Left, Right: TCircle;
+ cross: Double;
+ begin
+ Left := TCircle.DEFAULT_VALUE;
+ Right := TCircle.DEFAULT_VALUE;
+
+ circ := NewCircle2(P, Q);
+
+ // For each point not in the two-point circle
+ for I := 0 to Min(stop, High(Points)) do
+ begin
+ if (circ.Contains(Points[I])) then
+ Continue;
+
+ // Form a circumcircle and classify it on Left or Right side
+ cross := TSimbaGeometry.CrossProduct(P, Q, Points[I]);
+ c := NewCircle3(P, Q, Points[I]);
+ if (c.Radius = 0) then
+ Continue;
+
+ if (cross > 0) and ((Left.Radius = 0) or (TSimbaGeometry.CrossProduct(P, Q, C.Center) > TSimbaGeometry.CrossProduct(P, Q, Left.Center))) then
+ Left := c
+ else
+ if (cross < 0) and ((Right.Radius = 0) or (TSimbaGeometry.CrossProduct(P, Q, C.Center) < TSimbaGeometry.CrossProduct(P, Q, Right.Center))) then
+ Right := c;
+ end;
+
+ // Select which circle to return
+ if (Left.Radius = 0) and (Right.Radius = 0) then
+ Result := circ
+ else if (Left.Radius = 0) then
+ Result := Right
+ else if (Right.Radius = 0) or (Left.Radius <= Right.Radius) then
+ Result := Left
+ else
+ Result := Right;
+ end;
+
+ // One boundary point known
+ function makeCircleOnePoint(stop:Integer; P:TPoint): TCircle;
+ var
+ I: Integer;
+ Q: TPoint;
+ begin
+ Result := TCircle.Create(P, 0);
+
+ for I := 0 to Min(stop, High(Points)) do
+ begin
+ Q := Points[I];
+ if Result.Contains(Q) then
+ Continue;
+
+ if (Result.Radius = 0) then
+ Result := NewCircle2(P, Q)
+ else
+ Result := makeCircleTwoPoints(I+1, P, Q);
+ end;
+ end;
+
+var
+ I: Integer;
+ P: TPoint;
+begin
+ Result := TCircle.DEFAULT_VALUE;
+
+ if (Length(Self) = 1) then
+ Result.Center := Self[0]
+ else
+ if (Length(Self) > 1) then
+ begin
+ // Copy the list and shuffle
+ Points := Copy(Self);
+ for I := High(Points) downto 0 do
+ Swap(Points[I], Points[Random(I+1)]);
+
+ // Add Points to circle one by one, and if needed recompute circle
+ for I := 0 to High(Points) do
+ begin
+ P := Points[I];
+ if (Result.Radius = 0) or (not Result.Contains(P)) then
+ Result := makeCircleOnePoint(I+1, P);
+ end;
+ end;
+end;
+
end.