{ %opt=-Ootailrec } program gx; //fpc -O3 ax.pas // graphmath.pp(518,7) Fatal: Internal error 200108231 {$Mode OBJFPC} {$H+} {$inline on} uses types,math; type PPoint = ^TPoint; TFloatPoint = Record X, Y : Extended; end; TBezier = Array[0..3] of TFloatPoint; const res: array[0..50] of tpoint = ( (x: 1; y: 10), (x: 0; y: -321), (x: -3; y: -454), (x: -8; y: -567), (x: -16; y: -661), (x: -21; y: -701), (x: -28; y: -737), (x: -35; y: -769), (x: -44; y: -797), (x: -54; y: -821), (x: -65; y: -842), (x: -78; y: -858), (x: -93; y: -872), (x: -109; y: -882), (x: -127; y: -889), (x: -147; y: -893), (x: -168; y: -895), (x: -192; y: -893), (x: -218; y: -890), (x: -246; y: -884), (x: -276; y: -875), (x: -344; y: -853), (x: -422; y: -823), (x: -510; y: -788), (x: -611; y: -747), (x: -724; y: -704), (x: -850; y: -658), (x: -989; y: -611), (x: -1143; y: -565), (x: -1226; y: -542), (x: -1313; y: -519), (x: -1403; y: -497), (x: -1498; y: -476), (x: -1597; y: -456), (x: -1700; y: -437), (x: -1807; y: -419), (x: -1919; y: -403), (x: -2035; y: -388), (x: -2156; y: -375), (x: -2282; y: -363), (x: -2413; y: -354), (x: -2548; y: -346), (x: -2688; y: -341), (x: -2834; y: -339), (x: -2984; y: -339), (x: -3140; y: -341), (x: -3301; y: -347), (x: -3467; y: -355), (x: -3639; y: -367), (x: -3817; y: -382), (x: -4000; y: -400) ); Operator + (const Addend1, Addend2 : TFloatPoint) : TFloatPoint; inline; Begin With Result do begin X := Addend1.X + Addend2.X; Y := Addend1.Y + Addend2.Y; end; end; Operator * (const Multiplicand : TFloatPoint; Multiplier : Extended) : TFloatPoint; Begin With Result do begin X := Multiplicand.X * Multiplier; Y := Multiplicand.Y * Multiplier; end; end; Operator * (Multiplicand : Extended; const Multiplier : TFloatPoint) : TFloatPoint; Begin Result := Multiplier*Multiplicand; end; Operator / (const Dividend : TFloatPoint; Divisor : Extended) : TFloatPoint; begin With Result do begin X := Dividend.X / Divisor; Y := Dividend.Y / Divisor; end; end; Operator := (const Value : TFloatPoint) : TPoint; inline; begin Result.X := Trunc(SimpleRoundTo(Value.X, 0)); Result.Y := Trunc(SimpleRoundTo(Value.Y, 0)); end; function Distance(const Pt1,Pt2 : TPoint) : Extended; begin Result := Sqrt(Sqr(Pt2.X - Pt1.X) + Sqr(Pt2.Y - Pt1.Y)); end; {------------------------------------------------------------------------------ Method: Distance Params: PT, SP,EP Returns: Extended Use Distance to get the distance between any point(PT) and a line defined by any two points(SP, EP). Intended for use in Bezier2Polyline, so params are TFloatPoint's, NOT TPoint's. ------------------------------------------------------------------------------} function Distance(const Pt, SP, EP : TFloatPoint) : Extended; var A, B, C : Extended; function Slope(PT1,Pt2 : TFloatPoint) : Extended; begin If Pt2.X <> Pt1.X then Result := (Pt2.Y - Pt1.Y) / (Pt2.X - Pt1.X) else Result := 1; end; function YIntercept(PT1,Pt2 : TFloatPoint) : Extended; begin Result := Pt1.Y - Slope(Pt1,Pt2)*Pt1.X; end; begin A := -Slope(SP,EP); B := 1; C := -YIntercept(SP, EP); Result := ABS(A*Pt.X + B*Pt.Y + C)/Sqrt(Sqr(A) + Sqr(B)); end; function BezierMidPoint(const Bezier : TBezier) : TFloatPoint; begin Result := (Bezier[0] + 3*Bezier[1] + 3*Bezier[2] + Bezier[3]) / 8; end; procedure SplitBezier(const Bezier : TBezier; var Left, Right : TBezier); var Tmp : TFloatPoint; begin Tmp := (Bezier[1] + Bezier[2]) / 2; left[0] := Bezier[0]; Left[1] := (Bezier[0] + Bezier[1]) / 2; left[2] := (Left[1] + Tmp) / 2; Left[3] := BezierMidPoint(Bezier); right[3] := Bezier[3]; right[2] := (Bezier[2] + Bezier[3]) / 2; Right[1] := (Right[2] + Tmp) / 2; right[0] := BezierMidPoint(Bezier); end; procedure Bezier2Polyline(const Bezier : TBezier; var Points : PPoint; var Count : Longint); var Pt : TPoint; procedure AddPoint(const Point : TFloatPoint); var P : TPoint; begin P := Point; if (Pt <> P) then begin Inc(Count); ReallocMem(Points, SizeOf(TPoint) * Count); Points[Count - 1] := P; Pt := P; end; end; function Colinear(BP : TBezier; Tolerance : Extended) : Boolean; var D : Extended; begin D := SQR(Distance(BP[1], BP[0], BP[3])); Result := D < Tolerance; D := SQR(Distance(BP[2], BP[0], BP[3])); If Result then Result := Result and (D < Tolerance); end; procedure SplitRecursive(B : TBezier); var Left, Right : TBezier; begin If Colinear(B, 1) then begin AddPoint(B[0]); AddPoint(B[3]); end else begin SplitBezier(B,left,right); SplitRecursive(left); SplitRecursive(right); end; end; begin Pt := Point(-1,-1); If (not Assigned(Points)) or (Count <= 0) then begin Count := 0; if Assigned(Points) then ReallocMem(Points, 0); end; SplitRecursive(Bezier); end; var points: ppoint; i, ppointcount: longint; bezier: TBezier; begin bezier[0].X := 1.0; bezier[0].Y := 10.0; bezier[1].X := 2.0; bezier[1].Y := -2000.0; bezier[2].X := -30.0; bezier[2].Y := 30.0; bezier[3].X := -4000.0; bezier[3].Y := -400.0; Bezier2Polyline(bezier,points, ppointcount); for i:=0 to ppointcount-1 do begin if (points[i].x <> res[i].x) and (points[i].y <> res[i].y) then halt(i+1); // writeln(points[i].x,' ',points[i].y); end; end.