////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// This unit containts Command Line arguments parser.                         //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 2001xxxx - Created by A.K.                                                 //
// 20230506 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_delauna; // Delaunay triangulation and it's implementations.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

{$IFDEF CPU32}
{$WARN 4080 off : Converting the operands to "$1" before doing the subtract could prevent overflow errors.}
{$ENDIF ~CPU32}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_ef, _crw_fpu, _crw_plut, _crw_fifo, _crw_sort;

 { Virtual drawer to view triangulation }
type
 TLineDrawProcedure=procedure(var x,y:TPoint2d);

 {
 Delaunay triangulation objects.
 }
type
 PEdgeData             = ^TEdgeData;
 PQuadEdge             = ^TQuadEdge;
 PEdge                 = ^TEdge;
 TDelaunayTriangulator = Class;
 TEdgeData = record
  p:TPoint2d;
  z:double;
  i:integer;
 end;
 TEdge = object
 private
  Number : integer;
  Next   : PEdge;
  Data   : TEdgeData;
 public
  procedure Init;
  function  Qedge:PQuadEdge;
  function  Roll(Step:integer):PEdge;
  function  Rot:PEdge;
  function  invRot:PEdge;
  function  Sym:PEdge;
  function  ONext:PEdge;
  function  OPrev:PEdge;
  function  DNext:PEdge;
  function  DPrev:PEdge;
  function  LNext:PEdge;
  function  LPrev:PEdge;
  function  RNext:PEdge;
  function  RPrev:PEdge;
  function  Org:PEdgeData;
  function  Dest:PEdgeData;
  procedure EndPoints(var p,q:TEdgeData);
  function  Eps:double;
  procedure Draw(stamp:integer; LineDraw:TLineDrawProcedure);
 end;
 TQuadEdge = object
 private
  Edge   : array[0..3] of TEdge;
  Next   : PQuadEdge;
  Owner  : TDelaunayTriangulator;
  Stamp  : integer;
 public
  function  Init(AOwner:TDelaunayTriangulator; ANext:PQuadEdge):PQuadEdge;
  function  TimeStamp(AStamp:integer):boolean;
 end;
 TDelaunayTriangulator=class(TMasterObject)
 private
  StartingEdge : PEdge;
  StartingQuad : PQuadEdge;
  Range        : record a,b:TPoint2d; end;
  First        : record a,b,c:TPoint2d; end;
  Epsilon      : double;
  TimeStamp    : integer;
  ErrorCount   : integer;
 public
  constructor Create(var x,y,z:array of double; n:integer; x1,y1,x2,y2:double);
  destructor  Destroy;override;
  procedure   FirstTriangle(var a,b,c:TEdgeData);
  function    NewEdge:PEdge;
  procedure   DeleteEdge(e:PEdge);
  procedure   Splice(a,b:PEdge);
  function    Connect(a,b:PEdge):PEdge;
  procedure   Swap(e:PEdge);
  function    OnEdge(var x:TPoint2d; e:PEdge):boolean;
  function    Locate(var x:TPoint2d):PEdge;
  procedure   InsertSite(var x:TEdgeData);
  procedure   Draw(LineDraw:TLineDrawProcedure);
  function    Interpolate(x,y:double):double;
 end;

 { Relative epsilon to find 'small' values }
const
 DelaunayRelEps = 1e-10;

 {
 Easy-to-use interface for 3d-interpolation of z(x,y) surface
 by given random set x,y,z of n points on x1,y1,x2,y2 square.
 This procedures uses Delaunay triangulation.
 }
function  InitInterpolation3d(var x,y,z:array of double; n:integer;
                             x1,y1,x2,y2:double):boolean;
procedure DoneInterpolation3d;
function  Interpolation3d(x,y:double):double;
const
 TheDelaunayTriangulator:TDelaunayTriangulator=nil;

 {
 Easy to use procedure of z(x,y) surface interpolation
 }
function  Interpolate3d(var x,y,z:array of double; n:integer;
                        var zmatr:array of double; nx,ny,m:integer;
                        x1,y1,x2,y2:double):boolean;

type
 TPlotter3d = class(TLatch)
 private
  myN   : Integer;
  myX   : PDoubleArray;
  myY   : PDoubleArray;
  myZ   : PDoubleArray;
  myT   : TDelaunayTriangulator;
  myM   : TPoint2I;
  myS   : TPoint2D;
  myEps : Double;
  function Regular(x1,y1,x2,y2:Double):Boolean;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   Clear;
  procedure   Add(x,y,z:double);
  function    Accept(x1,y1,x2,y2:double):boolean;
  function    Interpolate(x,y:double):double;
  function    Ready:boolean;
  function    N:Integer;
 end;

implementation

 {
 ******************************************
 Geometric Predicates for Delaunay Diagrams
 ******************************************
 }

 {
 Return length of vector ( sqrt(sqr(x)+sqr(y)), but more fast)
 }
function norm2d(var v:TPoint2d):double;
begin
 norm2d:=hypot(v.x,v.y);
end;

 {
 Return distance between two points
 }
function distance2d(var u,v:TPoint2d):double;
var delta:TPoint2d;
begin
 delta.x:=u.x-v.x;
 delta.y:=u.y-v.y;
 distance2d:=norm2d(delta);
end;

 {
 Return true if two points equals with tolerance eps
 }
function equals2d(var v,u:TPoint2d; eps:double):boolean;
begin
 equals2d:=distance2d(u,v)<eps;
end;

 {
 Computes the normalized line equation a*x+b*y+c=0 through the points p and q.
 Then plugs point z into the line equation.
 Result <0,=0,>0 if z left of, on or right of the line, respectively.
 }
function LineEval(var p,q,z:TPoint2d):double;
var len:double; t:TPoint2D; a,b,c:double;
begin
 t.x:=q.x-p.x;
 t.y:=q.y-p.y;
 len:=norm2d(t);
 a:= t.y/len;
 b:=-t.x/len;
 c:=-(a*p.x+b*p.y);
 LineEval:=a*z.x+b*z.y+c;
end;

 {
 Returns twice the area of the oriented triangle (a, b, c), i.e., the
 area is positive if the triangle is oriented counterclockwise.
 }
function TriArea(var a,b,c:TPoint2d):double;
begin
 TriArea:=(b.x-a.x)*(c.y-a.y)-(b.y-a.y)*(c.x-a.x);
end;

 {
 Returns true if the point d is inside the circle defined by the
 points a, b, c. See Guibas and Stolfi (1985) p.107.
 }
function InCircle(var a,b,c,d:TPoint2d):boolean;
begin
 InCircle:=((a.x*a.x + a.y*a.y) * TriArea(b, c, d) -
	    (b.x*b.x + b.y*b.y) * TriArea(a, c, d) +
	    (c.x*c.x + c.y*c.y) * TriArea(a, b, d) -
	    (d.x*d.x + d.y*d.y) * TriArea(a, b, c) > 0);
end;

 {
 Returns true if the points a, b, c are in a counterclockwise order
 }
function ccw(var a,b,c:TPoint2d):boolean;
begin
 ccw:=(TriArea(a, b, c) > 0);
end;

 {
 Returns true if the point x and edge e are in a counterclockwise order
 }
function RightOf(var x:TPoint2d; e:PEdge):boolean;
begin
 RightOf:=ccw(x, e^.Dest^.p, e^.Org^.p);
end;

 {
 Returns true if the point x and edge e are not in a counterclockwise order
 }
function LeftOf(var x:TPoint2d; e:PEdge):boolean;
begin
 LeftOf:=ccw(x, e^.Org^.p, e^.Dest^.p);
end;

 {
 Test and makes triangle a,b,c just counterclockwise oriented triangle.
 }
procedure MakeTriangleCcw(var a,b,c:TPoint2d);
var d:TPoint2d;
begin
 {if triangle not counterclockwise, make it}
 if TriArea(a,b,c)<0 then begin
  d:=b;
  b:=c;
  c:=d;
 end;
end;

 {
 Return true if point p is equals one of a,b,c vertexes of triangle
 }
function isVertex(var a,b,c,p:TPoint2d; eps:double):boolean;
begin
 isVertex:=equals2d(a, p, eps) or equals2d(b, p, eps) or equals2d(c, p, eps);
end;

 {
 Return true if the point d inside of the a,b,c triangle or if it is in the
 eps-neighborhood of the edges.
 }
function TriangleContains(var a,b,c,d:TPoint2d; eps:double):boolean;
var p0,p1,p2:TPoint2d;
begin
 TriangleContains:=false;
 {evaluate p0,p1,p2 is just counterclockwise oriented triangle.}
 p0:=a;
 p1:=b;
 p2:=c;
 MakeTriangleCcw(p0,p1,p2);
 {d is inside of oriented triangle if right of or on counterclockwise edges}
 if LineEval(p0,p1,d)>eps then exit;
 if LineEval(p1,p2,d)>eps then exit;
 if LineEval(p2,p0,d)>eps then exit;
 TriangleContains:=true;
end;

 {
 Calculate interpolation in the triangle (x[0],y[0]),(x[1],y[1]),(x[2],y[2])
 with given z[0],z[1],z[2] at point (x[3],y[3]), result is z[3].
 Return true if success.
 Details: first,solve linear equations
           z[0]=a*x[0]+b*y[0]+c
           z[1]=a*x[1]+b*y[1]+c
           z[2]=a*x[2]+b*y[2]+c
           solution available if determinant <> 0
          next,calculate z=a*x+b*y+c at given x,y
 Note: after Delaunay triangulation all triangles good and no problems
       to solve.
 }
function TriangleSolve(var x,y,z:array of double):boolean;
var a,b,c,det:double;
begin
 TriangleSolve:=false;
 z[3]:=0;
 det:=x[0]*(y[1]-y[2])+x[1]*(y[2]-y[0])+x[2]*(y[0]-y[1]);
 if abs(det)<1e-100 then exit;
 a:=(z[0]*(y[1]-y[2])+z[1]*(y[2]-y[0])+z[2]*(y[0]-y[1]));
 b:=(z[0]*(x[2]-x[1])+z[1]*(x[0]-x[2])+z[2]*(x[1]-x[0]));
 c:=(z[0]*(x[1]*y[2]-x[2]*y[1])+z[1]*(x[2]*y[0]-x[0]*y[2])+z[2]*(x[0]*y[1]-x[1]*y[0]));
 z[3]:=(a*x[3]+b*y[3]+c)/det;
 TriangleSolve:=true;
end;

 {
 Calculate interpolation d.z at point d.p for given triangle a,b,c.
 Return true if success.
 }
function TriangleInterpolation(var a,b,c,d:TEdgeData):boolean;
var x,y,z:array[0..3] of double;
begin
 x[0]:=a.p.x; y[0]:=a.p.y; z[0]:=a.z;
 x[1]:=b.p.x; y[1]:=b.p.y; z[1]:=b.z;
 x[2]:=c.p.x; y[2]:=c.p.y; z[2]:=c.z;
 x[3]:=d.p.x; y[3]:=d.p.y;
 TriangleInterpolation:=TriangleSolve(x,y,z);
 d.z:=z[3];
end;

 {
 ************************
 TQuadEdge implementation
 ************************
 }
 {
 Return @Self, initialize Owner and other fields and connect Next
 Uses to create StartingQuad^.Next^.Next^.Next... nil-terminated list
 }
function  TQuadEdge.Init(AOwner:TDelaunayTriangulator; ANext:PQuadEdge):PQuadEdge;
begin
 Init:=@Self;
 Owner:=AOwner;
 Next:=ANext;
 Edge[0].Init;
 Edge[1].Init;
 Edge[2].Init;
 Edge[3].Init;
 Edge[0].Number:=0;
 Edge[1].Number:=1;
 Edge[2].Number:=2;
 Edge[3].Number:=3;
 Edge[0].Next:=@Edge[0];
 Edge[1].Next:=@Edge[3];
 Edge[2].Next:=@Edge[2];
 Edge[3].Next:=@Edge[1];
 Stamp:=0;
end;

 {
 Uses by recursive version of Draw
 }
function TQuadEdge.TimeStamp(AStamp:integer):boolean;
begin
 if (Stamp<>AStamp) then begin
  Stamp:=AStamp;
  TimeStamp:=true;
 end else TimeStamp:=false;
end;

 {
 ********************
 TEdge implementation
 ********************
 }
 {
 Fills with  zero all fields
 }
procedure TEdge.Init;
begin
 Number:=0;
 Next:=nil;
 Data.p.x:=0;
 Data.p.y:=0;
 Data.z:=0;
 Data.i:=0;
end;

 {
 Return owner TQuadEdge where the given edge are.
 }
function TEdge.Qedge:PQuadEdge;
begin
 Qedge:=DecPtr(@Self,sizeof(Self)*Number);
end;

 {
 Return other edge in owner edges, cyclic rolled by Step.
 }
function TEdge.Roll(Step:integer):PEdge;
begin
 Roll:=@Qedge^.Edge[(Number+Step) and 3];
end;

 {
 Return the dual of the current edge, directed from its right to its left.
 }
function TEdge.Rot:PEdge;
begin
 Rot:=Roll(1);
end;

 {
 Return the dual of the current edge, directed from its left to its right.
 }
function TEdge.invRot:PEdge;
begin
 invRot:=Roll(3);
end;

 {
 Return the edge from the destination to the origin of the current edge.
 }
function TEdge.Sym:PEdge;
begin
 Sym:=Roll(2);
end;

 {
 Return the next ccw edge around (from) the origin of the current edge.
 }
function TEdge.ONext:PEdge;
begin
 ONext:=Next;
end;

 {
 Return the next cw edge around (from) the origin of the current edge.
 }
function TEdge.OPrev:PEdge;
begin
 OPrev:=Rot^.ONext^.Rot;
end;

 {
 Return the next ccw edge around (into) the destination of the current edge.
 }
function TEdge.DNext:PEdge;
begin
 DNext:=Sym^.ONext^.Sym;
end;

 {
 Return the next cw edge around (into) the destination of the current edge.
 }
function TEdge.DPrev:PEdge;
begin
 DPrev:=invRot^.ONext^.invRot;
end;

 {
 Return the ccw edge around the left face following the current edge.
 }
function TEdge.LNext:PEdge;
begin
 LNext:=invRot^.ONext^.Rot;
end;

 {
 Return the ccw edge around the left face before the current edge.
 }
function TEdge.LPrev:PEdge;
begin
 LPrev:=ONext^.Sym;
end;

 {
 Return the edge around the right face ccw following the current edge.
 }
function TEdge.RNext:PEdge;
begin
 RNext:=Rot^.ONext^.invRot;
end;

 {
 Return the edge around the right face ccw before the current edge.
 }
function TEdge.RPrev:PEdge;
begin
 RPrev:=Sym^.ONext;
end;

 {
 Return original endpoint of edge
 }
function TEdge.Org:PEdgeData;
begin
 Org:=@Data;
end;

 {
 Return destination endpoint of edge
 }
function TEdge.Dest:PEdgeData;
begin
 Dest:=@Sym^.Data;
end;

 {
 Set edge endpoints
 }
procedure TEdge.EndPoints(var p,q:TEdgeData);
begin
 Org^:=p;
 Dest^:=q;
end;

 {
 Return epsilon of edge's owner.
 Note: data set may be of different range, that is why we need to
       calculate absolute threshold for 'small' values - epsilon
       for given data set.
 }
function TEdge.Eps:double;
begin
 Eps:=Qedge^.Owner.Epsilon;
end;


 {
 This is a recursive drawing routine that uses time stamps to
 determine if the edge has already been drawn. This is given
 here for testing purposes only: it is not efficient, and for
 large triangulations the stack might overflow. A better way
 of doing this (and other traversals of the edges) is to maintain
 a list of edges in the corresponding DelaunayTriangulator object. This
 list should be updated every time an edge is created or destroyed.
 }
procedure TEdge.Draw(stamp:integer; LineDraw:TLineDrawProcedure);
begin
 if Qedge^.TimeStamp(stamp) then begin
  { Draw the edge }
  LineDraw(Org^.p,Dest^.p);
  {visit neighbors}
  ONext^.Draw(stamp,LineDraw);
  OPrev^.Draw(stamp,LineDraw);
  DNext^.Draw(stamp,LineDraw);
  DPrev^.Draw(stamp,LineDraw);
 end;
end;


 {
 ******************************************************************
 TDelaunayTriangulator implementation - Basic Topological Operators
 ******************************************************************
 }
 {
 Constructor create Delaunay triangulation to use for surface interpolation
 for given random x,y,z set.
 x1,y1,x2,y2 is a bar contains all points for future interpolation.
 Automatically founds first triangle contains all data points and points
 for future interpolation.
 }
constructor TDelaunayTriangulator.Create(var x,y,z:array of double; n:integer;
                                       x1,y1,x2,y2:double);
var a,b,c:TEdgeData; i:integer; center:TPoint2d; ave,radius:double;
begin
 {create object instance and list of edges}
 inherited Create;
 StartingEdge:=nil;
 StartingQuad:=nil;
 TimeStamp:=0;
 ErrorCount:=0;
 {find data range and average}
 ave:=0;
 Range.a.x:=min(x1,x2);
 Range.a.y:=min(y1,y2);
 Range.b.x:=max(x1,x2);
 Range.b.y:=max(y1,y2);
 for i:=0 to n-1 do begin
  Range.a.x:=min(Range.a.x,x[i]);
  Range.a.y:=min(Range.a.y,y[i]);
  Range.b.x:=max(Range.b.x,x[i]);
  Range.b.y:=max(Range.b.y,y[i]);
  ave:=ave+z[i];
 end;
 ave:=ave/n;
 {check range to be not empty}
 if Range.a.x=Range.b.x then begin
  Range.a.x:=-1;
  Range.b.x:=+1;
 end;
 if Range.a.y=Range.b.y then begin
  Range.a.y:=-1;
  Range.b.y:=+1;
 end;
 {find triangle contains unit circle}
 a.p.x:=1/sin(pi/6);
 a.p.y:=0;
 a.z:=ave;
 a.i:=-1;
 b.p.x:=-1;
 b.p.y:=1/tan(pi/6);
 b.z:=ave;
 b.i:=-1;
 c.p.x:=-1;
 c.p.y:=-1/tan(pi/6);
 c.z:=ave;
 c.i:=-1;
 {grow triangle to contain real data radius}
 radius:=0.5*distance2d(Range.a,Range.b);
 radius:=radius*1.5;  {some grow for stable}
 a.p.x:=a.p.x*radius;
 a.p.y:=a.p.y*radius;
 b.p.x:=b.p.x*radius;
 b.p.y:=b.p.y*radius;
 c.p.x:=c.p.x*radius;
 c.p.y:=c.p.y*radius;
 {move triangle to real place at the center of data range}
 center.x:=Range.a.x+0.5*(Range.b.x-Range.a.x);
 center.y:=Range.a.y+0.5*(Range.b.y-Range.a.y);
 a.p.x:=a.p.x+center.x;
 a.p.y:=a.p.y+center.y;
 b.p.x:=b.p.x+center.x;
 b.p.y:=b.p.y+center.y;
 c.p.x:=c.p.x+center.x;
 c.p.y:=c.p.y+center.y;
 {find Epsilon - threshold for 'small' values relative to data range}
 Epsilon:=distance2d(Range.a,Range.b)*DelaunayRelEps;
 {init first triangle}
 FirstTriangle(a,b,c);
 {and add all other points}
 for i:=0 to n-1 do begin
  a.p.x:=x[i];
  a.p.y:=y[i];
  a.z:=z[i];
  a.i:=i;
  InsertSite(a);
 end;
end;

 {
 Destructor frees all egdes allocated by NewEdge calls.
 }
destructor TDelaunayTriangulator.Destroy;
var quad:PQuadEdge;
begin
 while Assigned(StartingQuad) do begin
  quad:=StartingQuad;
  StartingQuad:=StartingQuad^.Next;
  Dispose(quad);
 end;
 inherited Destroy;
end;

 {
 Allocate new edge, init edge's owner with Self and insert this edge
 to the nil-terminated list of edges: StartingQuad^.Next^.Next^... etc.
 }
function TDelaunayTriangulator.NewEdge:PEdge;
begin
 StartingQuad:=New(PQuadEdge)^.Init(Self,StartingQuad);
 NewEdge:=@StartingQuad^.Edge[0];
end;

 {
 This operator affects the two edge rings around the origins of a and b,
 and, independently, the two edge rings around the left faces of a and b.
 In each case, (i) if the two rings are distinct, Splice will combine
 them into one; (ii) if the two are the same ring, Splice will break it
 into two separate pieces.
 Thus, Splice can be used both to attach the two edges together, and
 to break them apart. See Guibas and Stolfi (1985) p.96 for more details
 and illustrations.
 }
procedure TDelaunayTriangulator.Splice(a,b:PEdge);
var alpha,beta,t1,t2,t3,t4:PEdge;
begin
 alpha:=a^.ONext^.Rot;
 beta:=b^.ONext^.Rot;
 t1:=b^.ONext;
 t2:=a^.ONext;
 t3:=beta^.ONext;
 t4:=alpha^.ONext;
 a^.Next:=t1;
 b^.Next:=t2;
 alpha^.Next:=t3;
 beta^.Next:=t4;
end;

 {
 Delete edge from edge's set and list, then free.
 }
procedure TDelaunayTriangulator.DeleteEdge(e:PEdge);
var quad:PQuadEdge;
begin
 Splice(e, e^.OPrev);
 Splice(e^.Sym, e^.Sym^.OPrev);
 {dispose e^.Qedge}
 if StartingQuad=e^.Qedge then begin
  StartingQuad:=e^.Qedge^.Next;
  Dispose(e^.Qedge);
 end else begin
  quad:=StartingQuad;
  while Assigned(quad) do begin
   if quad^.Next=e^.Qedge then begin
    quad^.Next:=e^.Qedge^.Next;
    Dispose(e^.Qedge);
    break;
   end;
   quad:=quad^.Next;
  end;
 end;
end;

 {
 Topological Operations for Delaunay Diagrams
 }

 {
 Initialize a subdivision to the triangle defined by the points a, b, c.
 }
procedure TDelaunayTriangulator.FirstTriangle(var a,b,c:TEdgeData);
var ea,eb,ec:PEdge;
begin
 ea:=NewEdge;
 ea^.EndPoints(a, b);
 eb:=NewEdge;
 Splice(ea^.Sym, eb);
 eb^.EndPoints(b, c);
 ec:=NewEdge;
 Splice(eb^.Sym, ec);
 ec^.EndPoints(c, a);
 Splice(ec^.Sym, ea);
 StartingEdge:=ea;
 {remember first triangle for future}
 First.a:=a.p;
 First.b:=b.p;
 First.c:=c.p;
end;

 {
 Add a new edge e connecting the destination of a to the
 origin of b, in such a way that all three have the same
 left face after the connection is complete.
 Additionally, the data pointers of the new edge are set.
 }
function TDelaunayTriangulator.Connect(a,b:PEdge):PEdge;
var e:PEdge;
begin
 e:=NewEdge;
 Splice(e, a^.LNext);
 Splice(e^.Sym, b);
 e^.EndPoints(a^.Dest^, b^.Org^);
 Connect:=e;
end;

 {
 Essentially turns edge e counterclockwise inside its enclosing
 quadrilateral. The data pointers are modified accordingly.
 }
procedure TDelaunayTriangulator.Swap(e:PEdge);
var a,b:PEdge;
begin
 a:=e^.OPrev;
 b:=e^.Sym^.OPrev;
 Splice(e, a);
 Splice(e^.Sym, b);
 Splice(e, a^.LNext);
 Splice(e^.Sym, b^.LNext);
 e^.EndPoints(a^.Dest^, b^.Dest^);
end;

 {
 A predicate that determines if the point x is on the edge e.
 The point is considered on if it is in the eps-neighborhood
 of the edge.
 }
function TDelaunayTriangulator.OnEdge(var x:TPoint2d; e:PEdge):boolean;
var t1,t2,t3:double;
begin
 t1:=distance2d(x, e^.Org^.p);
 t2:=distance2d(x, e^.Dest^.p);
 if (t1<e^.eps) or (t2 < e^.eps) then OnEdge:=true else begin
  t3:=distance2d(e^.Org^.p, e^.Dest^.p);
  if (t1 > t3) or (t2 > t3) then OnEdge:=false else begin
   OnEdge:=(abs(LineEval(e^.Org^.p, e^.Dest^.p, x))<=e^.eps);
  end;
 end;
end;

 {
 An Incremental Algorithm for the Construction of Delaunay Diagrams
 }

 {
 Returns an edge e, s.t. either x is on e, or e is an edge of
 a triangle containing x. The search starts from StartingEdge
 and proceeds in the general direction of x. Based on the
 pseudocode in Guibas and Stolfi (1985) p.121.
 }
function TDelaunayTriangulator.Locate(var x:TPoint2d):PEdge;
var e:PEdge;
begin
 {if point outside of first triangle, location may not be found}
 if not TriangleContains(First.a, First.b, First.c, x, Epsilon) then begin
  Locate:=nil;
  exit;
 end;
 {Ok,start search}
 e:=StartingEdge;
 while true do begin
  if equals2d(x, e^.Org^.p,  e^.eps) then break else
  if equals2d(x, e^.Dest^.p, e^.eps) then break else
  if RightOf(x, e) then e:=e^.Sym else
  if not RightOf(x, e^.ONext) then e:=e^.ONext else
  if not RightOf(x, e^.DPrev) then e:=e^.DPrev else break;
 end;
 Locate:=e;
end;

 {
 Inserts a new point into a subdivision representing a Delaunay
 triangulation, and fixes the affected edges so that the result
 is still a Delaunay triangulation. This is based on the
 pseudocode from Guibas and Stolfi (1985) p.120, with slight
 modifications and a bug fix.
 }
procedure TDelaunayTriangulator.InsertSite(var x:TEdgeData);
var e,base,t:PEdge;
begin
 {
 Find edge of triangle containing x
 }
 e:=Locate(x.p);
 {
 Point outside of first triangle?
 }
 if e=nil then begin
  inc(ErrorCount);
  exit;
 end;
 {
 Point is already in ?
 }
 if equals2d(x.p, e^.Org^.p,  e^.eps) then exit;
 if equals2d(x.p, e^.Dest^.p, e^.eps) then exit;
 {
 Out of memory?
 }
 //if MemAvail<1024 then begin
 // inc(ErrorCount);
 // exit;
 //end;
 {
 Special case if on edge
 }
 if OnEdge(x.p, e) then begin
  e:=e^.OPrev;
  DeleteEdge(e^.ONext);
 end;
 {
 Connect the new point to the vertices of the containing triangle
 (or quadrilateral, if the new point fell on an existing edge.)
 }
 base:=NewEdge;
 base^.EndPoints(e^.Org^, x);
 Splice(base, e);
 StartingEdge:=base;
 while true do begin
  base:=Connect(e, base^.Sym);
  e:=base^.OPrev;
  if e^.LNext=StartingEdge then break;
 end;
 {
 Examine suspect edges to ensure that the Delaunay condition is satisfied.
 }
 while true do begin
  t:=e^.OPrev;
  if RightOf(t^.Dest^.p, e) and
     InCircle(e^.Org^.p, t^.Dest^.p, e^.Dest^.p, x.p)
  then begin
   Swap(e);
   e:=e^.OPrev;
  end else
  if (e^.ONext=StartingEdge) then break               {no more suspect edges}
                             else e:=e^.ONext^.LPrev; {pop a suspect edge}
 end;
end;

 {
 Draws the Delaunay diagram with virtual drawer
 }
procedure TDelaunayTriangulator.Draw(LineDraw:TLineDrawProcedure);
var quad:PQuadEdge;
begin
 {non-recursive version}
 quad:=StartingQuad;
 while Assigned(quad) do begin
  LineDraw(quad^.edge[0].Org^.p, quad^.edge[0].Dest^.p);
  quad:=quad^.Next;
 end;
 { recursive version }
 {
 inc(TimeStamp);
 StartingEdge^.Draw(TimeStamp,LineDraw);
 }
end;

 {
 Linear interpolation of z(x,y) function.
 Returns Not A Number value if (x,y) point is out of range.
 }
function TDelaunayTriangulator.Interpolate(x,y:double):double;
var e:PEdge; a,b,c,d:TEdgeData;
begin
 {init record}
 d.p.x:=x;
 d.p.y:=y;
 d.z:=0;
 {find edge of triangle contains given point}
 e:=Locate(d.p);
 {given point out of range, could not interpolate}
 if e=nil then begin
  Interpolate:=_nan;
  exit;
 end;
 {a,b,c is counterclockwise triangle contains given point}
 a:=e^.Org^;
 b:=e^.Dest^;
 c:=e^.ONext^.Dest^;
 if not TriangleInterpolation(a, b, c, d) then d.z:=_nan;
 Interpolate:=d.z;
end;

 {
 Easy to use initialization for 3d interpolations
 }
function  InitInterpolation3d(var x,y,z:array of double; n:integer;
                             x1,y1,x2,y2:double):boolean;
begin
 DoneInterpolation3d;
 TheDelaunayTriangulator:=TDelaunayTriangulator.Create(x,y,z,n,x1,y1,x2,y2);
 TheDelaunayTriangulator.Master:=@TheDelaunayTriangulator;
 InitInterpolation3d:=Assigned(TheDelaunayTriangulator) and
                              (TheDelaunayTriangulator.ErrorCount=0);
end;

 {
 Easy to use finalization for 3d interpolations
 }
procedure DoneInterpolation3d;
begin
 if Assigned(TheDelaunayTriangulator) then Kill(TObject(TheDelaunayTriangulator));
end;

 {
 Easy to use 3d interpolation
 }
function  Interpolation3d(x,y:double):double;
var v:double;
begin
 if Assigned(TheDelaunayTriangulator)
 then v:=TheDelaunayTriangulator.Interpolate(x,y)
 else v:=_nan;
 if isnan(v) then v:=0;
 Interpolation3d:=v;
end;

 {
 Easy to use 3d  interpolation for surface plots.
 This procedure uses Delaunay triangulation to interpolate given
 data set x,y,z of n points.
 Result are z-matrix of interpolated values on regular x-y set
  x[i]=x1+i*(x2-x1)/(nx-1), i=0..nx-1
  y[j]=y1+j*(y2-y1)/(ny-1), j=0..ny-1
 Result stored in matrix zmatr in one-dimension array z[i,j]=z[i*m+j]
 }
function Interpolate3d(var x,y,z:array of double; n:integer;
                       var zmatr:array of double; nx,ny,m:integer;
                       x1,y1,x2,y2:double):boolean;
var TheDelaunay:TDelaunayTriangulator; i,j:integer; px,py,pz:double;
begin
 Interpolate3d:=true;
 TheDelaunay:=TDelaunayTriangulator.Create(x,y,z,n,x1,y1,x2,y2);
 if TheDelaunay.ErrorCount<>0 then Interpolate3d:=false;
 for i:=0 to nx-1 do begin
  for j:=0 to ny-1 do begin
   px:=x1+i*(x2-x1)/(nx-1);
   py:=y1+j*(y2-y1)/(ny-1);
   pz:=TheDelaunay.Interpolate(px,py);
   zmatr[i*m+j]:=pz;
   if isnan(pz) then Interpolate3d:=false;
  end;
 end;
 TheDelaunay.Free;
end;

constructor TPlotter3d.Create;
begin
 inherited Create;
 myN:=0;
 myX:=nil;
 myY:=nil;
 myZ:=nil;
 myT:=nil;
 myM:=Point2I(0,0);
 myS:=Point2D(0,0);
 myEps:=1E-8;
end;

destructor  TPlotter3d.Destroy;
begin
 Clear;
 inherited Destroy;
end;

procedure   TPlotter3d.Clear;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   myN:=0;
   Deallocate(Pointer(myX));
   Deallocate(Pointer(myY));
   Deallocate(Pointer(myZ));
   Kill(TObject(myT));
   myM:=Point2I(0,0);
   myS:=Point2D(0,0);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Clear');
 end;
end;

procedure   TPlotter3d.Add(x,y,z:double);
 function Check(var P:Pointer):boolean;
 begin
  if AllocSize(P)=0 then P:=Allocate(sizeof(myX[0])*64);
  if AllocSize(P) div sizeof(myX[0]) <= myN then Reallocate(P,AllocSize(P)*2);
  Result:=AllocSize(P) div sizeof(myX[0]) > myN;
 end;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   if Check(Pointer(myX)) and Check(Pointer(myY)) and Check(Pointer(myZ)) then begin
    myX[myN]:=x;
    myY[myN]:=y;
    myZ[myN]:=z;
    inc(myN);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Add');
 end;
end;

function TPlotter3d.Accept(x1,y1,x2,y2:double):boolean;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   Kill(TObject(myT));
   myM:=Point2I(0,0);
   myS:=Point2D(0,0);
   if Regular(x1,y1,x2,y2) then Result:=true else
   if myN>3 then begin
    myT:=TDelaunayTriangulator.Create(myX[0],myY[0],myZ[0],myN,x1,y1,x2,y2);
    if myT.ErrorCount<>0 then Kill(TObject(myT));
    Result:=myT.Ok;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Accept');
 end;
end;

function  TPlotter3d.Interpolate(x,y:double):double;
var i,j,k,rx,ry:Integer; ix,iy:Double; ax,ay,az:array[0..3] of Double;
begin
 Result:=_nan;
 if Assigned(Self) then
 try
  Lock;
  try
   if Assigned(myT) then Result:=myT.Interpolate(x,y);
   if myM.x>0 then begin
    ix:=(x-myX[0])*myS.x; rx:=Round(ix);
    iy:=(y-myY[0])*myS.y; ry:=Round(iy);
    if abs(ix-rx)+abs(iy-ry)<myEps then
    if (rx>=0) and (rx<myM.x) and (ry>=0) and (ry<myM.y) then begin
     Result:=myZ[rx*myM.y+ry];
     Exit;
    end;
    i:=Max(0,Min(myM.x-2,Trunc(ix)));
    j:=Max(0,Min(myM.y-2,Trunc(iy)));
    k:=(i+0)*myM.y+(j+0); ax[0]:=myX[k]; ay[0]:=myY[k]; az[0]:=myZ[k];
    k:=(i+0)*myM.y+(j+1); ax[1]:=myX[k]; ay[1]:=myY[k]; az[1]:=myZ[k];
    k:=(i+1)*myM.y+(j+0); ax[2]:=myX[k]; ay[2]:=myY[k]; az[2]:=myZ[k];
    k:=(i+1)*myM.y+(j+1); ax[3]:=myX[k]; ay[3]:=myY[k]; az[3]:=myZ[k];
    if Hypot(x-ax[3],y-ay[3])<Hypot(x-ax[0],y-ay[0]) then begin
     ax[0]:=ax[3]; ay[0]:=ay[3]; az[0]:=az[3];
    end;
    ax[3]:=x; ay[3]:=y; az[3]:=_nan;
    if TriangleSolve(ax,ay,az) then Result:=az[3];
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Interpolate');
 end;
end;

function TPlotter3d.Ready:boolean;
begin
 if Assigned(Self) then begin Lock; Result:=myT.Ok or (myM.x>0); Unlock; end else Result:=false;
end;

function TPlotter3d.N:Integer;
begin
 if Assigned(Self) then begin Lock; Result:=myN; Unlock; end else Result:=0;
end;

function ComparePlotter3d(Data,Key1,Key2:Pointer):Integer;
var i,j:Integer;
begin
 with TPlotter3d(Data) do begin
  i:=PointerToPtrInt(Key1);
  j:=PointerToPtrInt(Key2);
  if myX[i]<myX[j] then Result:=-1 else
  if myX[i]>myX[j] then Result:=+1 else
  if myY[i]<myY[j] then Result:=-1 else
  if myY[i]>myY[j] then Result:=+1 else Result:=0;
 end;
end;

function KeyOfPlotter3d(Data:Pointer; i:Integer):Pointer;
begin
 Result:=PtrIntToPointer(i);
end;

procedure SwapPlotter3d(Data:Pointer; i,j:Integer);
var p:Double;
begin
 with TPlotter3d(Data) do begin
  p:=myX[i]; myX[i]:=myX[j]; myX[j]:=p;
  p:=myY[i]; myY[i]:=myY[j]; myY[j]:=p;
  p:=myZ[i]; myZ[i]:=myZ[j]; myZ[j]:=p;
 end;
end;

function TPlotter3d.Regular(x1,y1,x2,y2:Double):Boolean;
var ix,iy:Integer; r:TRect2D; p:TPoint2D;
label NotRegular;
begin
 Result:=false;
 if Assigned(Self) then
 try
  Lock;
  try
   myM:=Point2I(0,0);
   myS:=Point2D(0,0);
   if N<4 then goto NotRegular;
   if not Sort(N,Self,ComparePlotter3d,KeyOfPlotter3d,SwapPlotter3d,nil) then goto NotRegular;
   r:=Rect2D(myX[0],myY[0],myX[N-1],myY[N-1]);
   if IsNanOrInf(r) then goto NotRegular;
   if RectIsEmpty(r) then goto NotRegular;
   if not RectContainsPoint(r,Point2D(x1,y1)) then goto NotRegular;
   if not RectContainsPoint(r,Point2D(x2,y2)) then goto NotRegular;
   for ix:=0 to N-1 do
   if PointIsEqual(r.a,Point2D(myX[ix],r.a.y)) then inc(myM.y) else Break;
   if myM.y<2 then goto NotRegular;
   myM.x:=N div myM.y;
   if (myM.y<2) or (N<>myM.x*myM.y) then goto NotRegular;
   myS:=Point2D((myM.x-1)/RectSizeX(r),(myM.y-1)/RectSizeY(r));
   for ix:=0 to myM.x-1 do
   for iy:=0 to myM.y-1 do begin
    p:=Point2D((myX[ix*myM.y+iy]-r.a.x)*myS.x,(myY[ix*myM.y+iy]-r.a.y)*myS.y);
    if not PointIsEqual(p,Point2D(ix,iy),myEps) then goto NotRegular;
    if IsNanOrInf(p) then goto NotRegular;
   end;
   Result:=true;
   Exit;
  NotRegular:
   myM:=Point2I(0,0);
   myS:=Point2D(0,0);
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'Regular');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_delauna;
begin
end;

procedure Free_crw_delauna;
begin
 DoneInterpolation3d;
end;

initialization

 Init_crw_delauna;

finalization

 Free_crw_delauna;

end.

//////////////
// END OF FILE
//////////////

