diff --git a/Source/script/imports/simba.import_base.pas b/Source/script/imports/simba.import_base.pas index 579e2cb56..25d407b86 100644 --- a/Source/script/imports/simba.import_base.pas +++ b/Source/script/imports/simba.import_base.pas @@ -483,6 +483,9 @@ procedure ImportBase(Compiler: TSimbaScript_Compiler); addGlobalType('array of TPoint', 'TPointArray'); addGlobalType('array of TPointArray', 'T2DPointArray'); + addGlobalType('record A, B, C: TPoint; end;', 'TTriangle'); + addGlobalType('array of TTriangle', 'TTriangleArray'); + addGlobalType('record Top, Right, Bottom, Left: TPoint; end;', 'TQuad'); addGlobalType('array of TQuad', 'TQuadArray'); diff --git a/Source/script/imports/simba.import_math.pas b/Source/script/imports/simba.import_math.pas index 337d9492b..af31fe233 100644 --- a/Source/script/imports/simba.import_math.pas +++ b/Source/script/imports/simba.import_math.pas @@ -202,6 +202,26 @@ procedure _LapePolygonArea(const Params: PParamArray; const Result: Pointer); LA PDouble(Result)^ := TSimbaGeometry.PolygonArea(PPointArray(Params^[0])^); end; +(* +PolygonArea +----------- +> function TriangulatePolygon(Polygon: TPointArray): TTriangleArray; +*) +procedure _LapeTriangulatePolygon(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PTriangleArray(Result)^ := TSimbaGeometry.TriangulatePolygon(PPointArray(Params^[0])^); +end; + +(* +PolygonArea +----------- +> function LineInPolygon(a1, a2: TPoint; const Polygon: TPointArray): Boolean; +*) +procedure _LapeLineInPolygon(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PBoolean(Result)^ := TSimbaGeometry.LineInPolygon(PPoint(Params^[0])^, PPoint(Params^[1])^, PPointArray(Params^[2])^); +end; + (* CrossProduct ------------ @@ -267,11 +287,21 @@ procedure _LapeDistToLine2(const Params: PParamArray; const Result: Pointer); LA --------------- > function PointInTriangle(const P, P1, P2, P3: TPoint): Boolean; *) -procedure _LapePointInTriangle(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapePointInTriangle1(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin PBoolean(Result)^ := TSimbaGeometry.PointInTriangle(PPoint(Params^[0])^, PPoint(Params^[1])^, PPoint(Params^[2])^, PPoint(Params^[3])^); end; +(* +PointInTriangle +--------------- +> function PointInTriangle(const P: TPoint; const Triangle: TTriangle): Boolean; +*) +procedure _LapePointInTriangle2(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PBoolean(Result)^ := TSimbaGeometry.PointInTriangle(PPoint(Params^[0])^, PTriangle(Params^[1])^.A, PTriangle(Params^[1])^.B, PTriangle(Params^[1])^.C); +end; + (* PointInBox ---------- @@ -376,7 +406,10 @@ procedure ImportMath(Compiler: TSimbaScript_Compiler); addGlobalFunc('function Modulo(const X, Y: Integer): Integer; overload', @_LapeModulo); addGlobalFunc('function Modulo(const X, Y: Double): Double; overload', @_LapeModuloF); - + + addGlobalFunc('function TriangulatePolygon(const Polygon: TPointArray): TTriangleArray', @_LapeTriangulatePolygon); + addGlobalFunc('function LineInPolygon(a1, a2: TPoint; const Polygon: TPointArray): Boolean', @_LapeLineInPolygon); + addGlobalFunc('function DeltaAngle(const DegreesA, DegreesB: Double; R: Double = 360): Double', @_LapeDeltaAngle); addGlobalFunc('function PolygonArea(const Polygon: TPointArray): Double', @_LapePolygonArea); addGlobalFunc('function ExpandPolygon(const Polygon: TPointArray; Amount: Integer): TPointArray', @_LapeExpandPolygon); @@ -387,8 +420,10 @@ procedure ImportMath(Compiler: TSimbaScript_Compiler); addGlobalFunc('function DistToLine(const P, P1, P2: TPoint; out Nearest: TPoint): Double; overload', @_LapeDistToLine1); addGlobalFunc('function DistToLine(const P, P1, P2: TPoint): Double; overload', @_LapeDistToLine2); - - addGlobalFunc('function PointInTriangle(const P, P1, P2, P3: TPoint): Boolean', @_LapePointInTriangle); + + addGlobalFunc('function PointInTriangle(const P, P1, P2, P3: TPoint): Boolean; overload', @_LapePointInTriangle1); + addGlobalFunc('function PointInTriangle(const P: TPoint; const Triangle: TTriangle): Boolean; overload', @_LapePointInTriangle2); + addGlobalFunc('function PointInBox(const P: TPoint; const Box: TBox): Boolean', @_LapePointInBox); addGlobalFunc('function PointInQuad(const P: TPoint; const A,B,C,D: TPoint): Boolean', @_LapePointInQuad); addGlobalFunc('function PointInPolygon(const P: TPoint; const Polygon: TPointArray): Boolean', @_LapePointInPolygon); diff --git a/Source/simba.base.pas b/Source/simba.base.pas index 8ecd724aa..d3c6f570f 100644 --- a/Source/simba.base.pas +++ b/Source/simba.base.pas @@ -278,6 +278,13 @@ TBox = record PBox = ^TBox; PBoxArray = ^TBoxArray; + TTriangle = record + A,B,C: TPoint; + end; + TTriangleArray = array of TTriangle; + PTriangle = ^TTriangle; + PTriangleArray = ^TTriangleArray; + TQuad = record Top: TPoint; Right: TPoint; diff --git a/Source/simba.geometry.pas b/Source/simba.geometry.pas index 86050f1f5..aaf10ffd6 100644 --- a/Source/simba.geometry.pas +++ b/Source/simba.geometry.pas @@ -43,6 +43,8 @@ TSimbaGeometry = class public class constructor Create; + class function LineInPolygon(a1, a2: TPoint; const Polygon: TPointArray): Boolean; + class function TriangulatePolygon(Polygon: TPointArray): TTriangleArray; class function PolygonArea(const Polygon: TPointArray): Double; static; inline; class function ExpandPolygon(const Polygon: TPointArray; Amount: Integer): TPointArray; static; class function CrossProduct(const r, p, q: TPoint): Int64; static; overload; inline; @@ -73,6 +75,9 @@ TSimbaGeometry = class implementation +uses + simba.vartype_pointarray; + class constructor TSimbaGeometry.Create; var I: Integer; @@ -343,6 +348,87 @@ class function TSimbaGeometry.PointInEllipse(const P, Center: TPoint; const YRad Result := (Sqr(X) * Sqr(YRadius)) + (Sqr(Y) * Sqr(XRadius)) <= (Sqr(YRadius) * Sqr(XRadius)); end; +class function TSimbaGeometry.LineInPolygon(a1, a2: TPoint; const Polygon: TPointArray): Boolean; +var + i: Int32; + p1, p2: TPoint; +begin + for i:=0 to High(Polygon)-1 do + begin + p1 := Polygon[i]; + p2 := Polygon[i + 1]; + if LinesIntersect(a1, a2, p1, p2) and not ((a1 = p1) or (a1 = p2) or (a2 = p1) or (a2 = p2)) then + Exit(False); + end; + + p1 := Polygon[High(Polygon)]; + p2 := Polygon[0]; + if LinesIntersect(a1, a2, p1, p2) and not ((a1 = p1) or (a1 = p2) or (a2 = p1) or (a2 = p2)) then + Exit(False); + + Result := True; +end; + +class function TSimbaGeometry.TriangulatePolygon(Polygon: TPointArray): TTriangleArray; +var + i,rshift: Int32; + A,B,C: TPoint; + tmp1,tmp2: TPointArray; + valid: Boolean; +begin + tmp1 := specialize Reversed(Polygon); + SetLength(tmp2, Length(Polygon)); + + rshift := 0; + while Length(tmp1) > 3 do + begin + valid := False; + i := 0; + rshift := 0; + while i < Length(tmp1) do + begin + A := tmp1[i]; + B := tmp1[(i+1) mod Length(tmp1)]; + C := tmp1[(i+2) mod Length(tmp1)]; + + if (CrossProduct(A,B,C) >= 0) and LineInPolygon(A,C, Polygon) then + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)].A := A; + Result[High(Result)].B := B; + Result[High(Result)].C := C; + + tmp2[rshift+i] := A; + tmp2[rshift+i+1] := C; + valid := True; + Inc(i,2); + if (B = tmp1[0]) then Inc(rshift); + end else + begin + tmp2[rshift+i] := A; + Inc(i); + end; + end; + + if not valid then Exit(); + //Remove all duplicates without changing order + //This is actually not bad here. + if (i-rshift) > Length(tmp1) then SetLength(tmp1, i-rshift); + Move(tmp2[rshift], tmp1[0], (i-rshift)*SizeOf(TPoint)); + + tmp1 := tmp1.Unique(); + end; + + if Length(tmp1) = 3 then + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)].A := tmp1[0]; + Result[High(Result)].B := tmp1[1]; + Result[High(Result)].C := tmp1[2]; + end; +end; + + class function TSimbaGeometry.PolygonArea(const Polygon: TPointArray): Double; var i, j: Integer;