From d0f921c35fa268175934f79d33204899c3f5ae13 Mon Sep 17 00:00:00 2001 From: Olly Date: Tue, 19 Sep 2023 02:25:42 +0100 Subject: [PATCH] TCircle from SRL --- DocGen/docgen.simba | 1 + Source/Simba.lpi | 10 +- Source/forms/simba.functionlistform.pas | 2 + .../imports/simba/simba.import_circle.pas | 228 ++++++++++++++++++ .../imports/simba/simba.import_quad.pas | 7 +- .../script/imports/simba/simba.import_tpa.pas | 18 +- Source/script/simba.compiler_dump.pas | 13 +- Source/script/simba.script_imports.pas | 2 + Source/simba.circle.pas | 164 +++++++++++++ Source/simba.inc | 2 +- Source/simba.mufasatypes.pas | 31 +++ Source/simba.threading.pas | 5 + Source/simba.tpa.pas | 141 ++++++++++- 13 files changed, 615 insertions(+), 9 deletions(-) create mode 100644 Source/script/imports/simba/simba.import_circle.pas create mode 100644 Source/simba.circle.pas 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.