////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// Define curve object, a threadsafe dynamic array of (X,Y) points.           //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20011218 - Creation (uses CRW16)                                           //
// 20020123 - SmartAddPoint, SmartAddMarker                                   //
// 20030330 - Struggle for safety (add some try/except checks)...             //
// 20030423 - Optimized TCurve.SetCount                                       //
// 20230602 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_curves;

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

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

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, graphics, math,
 _crw_alloc, _crw_fpu, _crw_ef, _crw_zm, _crw_str, _crw_sort, _crw_fifo,
 _crw_fio, _crw_spline, _crw_plut, _crw_ee, _crw_dynar;

const
 DefaultTCurveAbsEps   = 0;
 DefaultTCurveRelEps   = 1E-10;
 DefaultTCurveColor    = clBlack;
 DefaultTCurveStyle    = 0;
 DefaultTCurveCapacity = 0;
 DefaultTCurveStep     = 512;
 DefaultTCurveSmall    = 2;
 DefaultTCurveMarker   = 15;
 DefaultTCurveLine     = 1;

const                               { Curve flags uses by TCurve.Flags   }
 cfInvalid             = $00000001; { Curve Ok method returns false      }
 cfNoData              = $00000002; { Curve has no points                }
 cfNoComment           = $00000004; { Comment field has Count=0          }
 cfTooSmall            = $00000008; { Curve length < SmallLength         }
 cfNotSortedX          = $00000010; { Curve not sorted on x              }
 cfNotSortedY          = $00000020; { Curve not sorted on y              }
 cfDuplicatesX         = $00000040; { Curve have >1 points with same x   }
 cfDuplicatesY         = $00000080; { Curve have >1 points with same y   }
 cfNotEquiDistantX     = $00000100; { Curve have no const step along x   }
 cfNotEquiDistantY     = $00000200; { Curve have no const step along y   }
 cfHaveZeroX           = $00000400; { Curve have points with x=0         }
 cfHaveZeroY           = $00000800; { Curve have points with y=0         }
 cfHavePozitivX        = $00001000; { Curve have points with x>0         }
 cfHavePozitivY        = $00002000; { Curve have points with y>0         }
 cfHaveNegativX        = $00004000; { Curve have points with x<0         }
 cfHaveNegativY        = $00008000; { Curve have points with y<0         }
 cfNaNX                = $00010000; { Curve contains NAN X values        }
 cfNaNY                = $00020000; { Curve contains NAN Y values        }
 cfInfX                = $00040000; { Curve contains INF X values        }
 cfInfY                = $00080000; { Curve contains INF Y values        }
 cfNanXY               = cfNanX+cfNanY;
 cfInfXY               = cfInfX+cfInfY;
 cfNanInf              = cfNanXY+cfInfXY;

const                               { Flags used by SmartAddPoint   }
 afIgnoreNanX          = $00000001; { Ignore points with Nan X      }
 afIgnoreNanY          = $00000002; { Ignore points with Nan Y      }
 afIgnoreInfX          = $00000004; { Ignore points with Inf X      }
 afIgnoreInfY          = $00000008; { Ignore points with Inf Y      }
 afIgnoreLessX         = $00000010; { Ignore if X less  LastPoint.X }
 afIgnoreEqualX        = $00000020; { Ignore if X equal LastPoint.X }
 afPackDublicatesX     = $00000040; { Pack points with same X       }
 afPackDublicatesY     = $00000080; { Pack points with same Y       }
 afUpdateMarker        = $00000100; { Update SmartAddMarker value   }
 afIgnoreNanInf        = afIgnoreNanX+afIgnoreNanY+afIgnoreInfX+afIgnoreInfY;
 afIgnoreLEX           = afIgnoreLessX+afIgnoreEqualX;
 afPackDublicates      = afPackDublicatesX+afPackDublicatesY;
 afDefault             = afIgnoreNanInf+afIgnoreLEX+afPackDublicates+afUpdateMarker;

 {
 *******************************************************************************
 TCurve is dynamic array of (x,y) points to represent y(x) function table.
 Also some additional data: name, comment text, color...
 *******************************************************************************
 }
type
 TCurve = class;
 TCurveAddPointAction = procedure(Curve:TCurve; Custom:Pointer);
 TCurve = class(TLatch)
 private
  myX       : PDoubleArray;
  myY       : PDoubleArray;
  myCount   : LongInt;
  myStep    : LongInt;
  myName    : LongString;
  myColor   : LongInt;
  myStyle   : LongInt;
  myComment : TText;
  mySmartAddMarker : TPoint2D;
  function    GetPX:PDoubleArray;
  function    GetPY:PDoubleArray;
  function    GetXY(Num:LongInt):TPoint2D;
  procedure   PutXY(Num:LongInt; const aPoint:TPoint2D);
  function    GetCount:LongInt;
  procedure   SetCount(NewCount:LongInt);
  function    GetCapacity:LongInt;
  procedure   SetCapacity(NewCapacity:LongInt);
  function    GetStep:LongInt;
  procedure   SetStep(NewStep:LongInt);
  function    GetName:LongString;
  procedure   SetName(const NewName:LongString);
  function    GetComment:TText;
  function    GetColor:LongInt;
  procedure   SetColor(NewColor:LongInt);
  function    GetStyle:LongInt;
  procedure   SetStyle(NewStyle:LongInt);
  function    GetIsDynamic:Boolean;
  function    GetIsStatic:Boolean;
  function    GetLimits:TRect2D;
  function    GetLastPoint:TPoint2D;
  function    GetSmartAddMarker:TPoint2D;
  procedure   SetSmartAddMarker(const aMarker:TPoint2D);
 public
  {
  Creation and destruction
  }
  constructor Create(aCount    : LongInt     = 0;
               const aName     : LongString  = '';
                     aColor    : LongInt     = DefaultTCurveColor;
                     aStyle    : LongInt     = DefaultTCurveStyle;
                     aCapacity : LongInt     = DefaultTCurveCapacity;
                     aStep     : LongInt     = DefaultTCurveStep);
  destructor  Destroy; override;
 public
  {
  X[0..Count-1]     is X data pointer, uses only inside of lock/unlock frame for thread safety
  Y[0..Count-1]     is Y data pointer, uses only inside of lock/unlock frame for thread safety
  XY[0..Count-1]    is virtual (x,y) points array with range checking
  Count             is current number of points
  Capacity          is current points buffer length
  Step              is Capacity grow adjustment step
  Name              is name of curve
  Comment           is text for comments
  Color             is curve color
  Style             is curve style
  isDynamic         Step>0 - curve uses for dynamic manipulations
  isStatic          Step=0 - curve uses for static  manipulations
  Limits            least rectangle contains all (x,y) points
  LastPoint         thread safe analog of XY[Count-1]
  SmartAddMarker    marker uses by SmartAddPoint to realtime curve updates
  }
  property    PX               : PDoubleArray   read GetPX;
  property    PY               : PDoubleArray   read GetPY;
  property    XY[i:LongInt]    : TPoint2D       read GetXY       write PutXY; default;
  property    Count            : LongInt        read GetCount    write SetCount;
  property    Capacity         : LongInt        read GetCapacity write SetCapacity;
  property    Step             : LongInt        read GetStep     write SetStep;
  property    Name             : LongString     read GetName     write SetName;
  property    Comment          : TText          read GetComment;
  property    Color            : LongInt        read GetColor    write SetColor;
  property    Style            : LongInt        read GetStyle    write SetStyle;
  property    IsDynamic        : Boolean        read GetIsDynamic;
  property    IsStatic         : Boolean        read GetIsStatic;
  property    Limits           : TRect2D        read GetLimits;
  property    LastPoint        : TPoint2D       read GetLastPoint;
  property    SmartAddMarker   : TPoint2D       read GetSmartAddMarker write SetSmartAddMarker;
 public
  {
  General data points deletion and insertion routines
  }
  procedure   DeletePoints(Num,NumPoints:LongInt);
  procedure   DeletePoint(Num:LongInt);
  procedure   InsertPoints(Num:LongInt; const aX,aY:array of Double; NumPoints:LongInt);
  procedure   InsertPoint(Num:LongInt; const aX,aY:Double);
  procedure   AddPoints(const aX,aY:array of Double; NumPoints:LongInt);
  procedure   AddPoint(const aX,aY:Double);
  procedure   SmartAddPoint(const aX,aY  : Double;
                                  Flags  : Cardinal = afDefault;
                                  Action : TCurveAddPointAction = nil;
                                  Custom : Pointer  = nil);
  procedure   ClearHistory(aHistLen:LongInt=0);  {Ограничить историю кривой HistLen последними точками}
 public
  {
  Clone       Create new curve, copy NumPoints starting from Num, other properties identical.
  GetPoints   Transfer datapoints to given x,y arrays.
  Assign      Copy all from data from Source
  Catenate    Add points from Source curve to tail.
  }
  function    Clone(Num:LongInt=0; NumPoints:LongInt=MaxNumDouble):TCurve;
  function    GetPoints(Num:LongInt; var aX,aY:array of Double; NumPoints:LongInt):LongInt;
  procedure   Assign(Source:TCurve);
  procedure   Catenate(Source:TCurve; CatComment:Boolean=false);
  procedure   AssignData(const XData,YData:array of Double; NumPoints:LongInt);
  procedure   CatenateData(const XData,YData:array of Double; NumPoints:LongInt);
  procedure   AssignComment(aComment:TText);
  procedure   CatenateComment(aComment:TText);
 public
  procedure   Move(dx,dy:Double);
  procedure   Mult(mx,my:Double);
  procedure   AddLn(const s:LongString);
  function    GetIndexAt(t:Double):Integer;
  function    Interpolate(t:Double):Double;
  function    Smooth(t:Double; Window:Double; Power,K1,K2:Integer):Double;
  function    Mediana(i,j:Integer; var aIndex:Integer; var aValue:Double; SortMethod:TSortMethod=smQuickSort):Boolean;
  function    Flags(AbsEps : Double  = DefaultTCurveAbsEps;
                    RelEps : Double  = DefaultTCurveRelEps;
                    Small  : Integer = DefaultTCurveSmall):LongInt;
  function    HasEquivalentData(Curve  : TCurve;
                                Mode   : Integer = 1; { 1=X, 2=Y }
                                AbsEps : Double  = DefaultTCurveAbsEps;
                                RelEps : Double  = DefaultTCurveRelEps):Boolean;
  function    GetTable(aText   : TText;
                       WX      : Integer = 0;
                       DX      : Integer = 16;
                       WY      : Integer = 0;
                       DY      : Integer = 16 ) : TText;
  procedure   ReadTable(Table:TText; XColumn,YColumn:Integer; Delims:TCharSet=[' ',',',ASCII_HT]);
 end;

type
 PCurveArray = ^TCurveArray;
 TCurveArray = array[0..MaxInt div SizeOf(TCurve)-1] of TCurve;

function  NewCurve(aCount    : LongInt     = 0;
             const aName     : LongString  = '';
                   aColor    : LongInt     = DefaultTCurveColor;
                   aStyle    : LongInt     = DefaultTCurveStyle;
                   aCapacity : LongInt     = DefaultTCurveCapacity;
                   aStep     : LongInt     = DefaultTCurveStep
                           ) : TCurve;
procedure Kill(var TheObject:TCurve); overload;
function  NewCurveCopy(Curve:TCurve; First:LongInt=0; Last:LongInt=MaxNumDouble-1):TCurve;
function  NewCurveCatenation(Curve1,Curve2:TCurve):TCurve;
function  NewCurveExtractX(Curve:TCurve):TCurve;
function  NewCurveExtractY(Curve:TCurve):TCurve;
function  NewCurveInverted(Curve:TCurve):TCurve;
function  NewCurveIntegral(Curve:TCurve; AFreeConst:Double=0):TCurve;
function  NewCurveDerivative(Curve:TCurve):TCurve;
function  NewCurveMedianFiltr(Curve  : TCurve;
                              Width  : Integer = 1;
                              AbsEps : Double  = DefaultTCurveAbsEps;
                              RelEps : Double  = DefaultTCurveRelEps
                                   ) : TCurve;

 {
 Evaluate curve by given formula. Example:
 c:=NewCurveByFormula(1000,0,2*pi,'x=t'+EOL+'y=sin(t)');
 }
function  NewCurveByFormula(NumPoints:LongInt; tmin,tmax:Double; const Formula:LongString):TCurve;

function  NewCurveExceptParametr(CurveX : TCurve;
                                 CurveY : TCurve;
                                 AbsEps : Double = DefaultTCurveAbsEps;
                                 RelEps : Double = DefaultTCurveRelEps
                                      ) : TCurve;

const                       {Flags using in NewCurveSorted mode}
 sfPrimaryY        = $0001; {Primary sort key is Y (else X, by default)}
 sfReversPrimary   = $0002; {Sort in revers direction on primary key}
 sfReversSecondary = $0004; {Sort in revers direction on secondary key}
 sfPack            = $0008; {Pack points with the same primary key}

function NewCurveSorted(Curve  : TCurve;
                        Flags  : Integer     = 0;
                        AbsEps : Double      = DefaultTCurveAbsEps;
                        RelEps : Double      = DefaultTCurveRelEps;
                        Method : TSortMethod = smShellSort
                             ) : TCurve;

 {
 *******************************************************************************
 TCurveList
 *******************************************************************************
 }
type
 TCurveListWriteTableProc = procedure(const aFormat:LongString; const aValue:Double; Custom:Pointer);
 TCurveList=class(TObjectStorage)
  function    GetCurve(i:LongInt):TCurve;
  procedure   PutCurve(i:LongInt; c:TCurve);
 public
  constructor Create(aOwns:Boolean);
  destructor  Destroy; override;
 public
  procedure   ClearHistory(aHistLen:LongInt=0);
  function    Find(aName:LongString):TCurve;
  function    GetList(aText:TText):TText;
  function    FormatTable(const Fmt       : LongString;
                                WriteProc : TCurveListWriteTableProc;
                                Custom    : Pointer):Boolean;
 public
  property    Curve[i:LongInt]:TCurve read GetCurve write PutCurve; default;
 end;

function  NewCurveList(aOwns:Boolean=true):TCurveList;
procedure Kill(var TheObject:TCurveList); overload;

 {
 *******************************************************************************
 Список кривых вводится через конструкцию, которая вносит в список кривую
 с заданным именем-дескриптором, нулевой длины, с параметрами по умолчанию

 [Curves]
 ;Identifier = Curve Length Step Color Marker  Line
 Temperature = Curve      0 1024    14     15     1
 Voltage     = Curve      0 1024  Blue      7     0

 При необходимости (но не обязательно) в том же файле может присутствовать
 секция с описанием подробностей, имя секции совпадает с идентификатором
 кривой

 [Temperature]
 RangeX = 0 1023
 Notice Text
 Текст комментария
 End Notice Text

 Пример вызова:
 List:=ReadCurveList(NewCurveList,'file.ini','[Section]');
 *******************************************************************************
 }
function ReadCurveList(List:TCurveList; const IniFile,SectionName:LongString):TCurveList;

implementation

constructor TCurve.Create(aCount    : LongInt     = 0;
                    const aName     : LongString  = '';
                          aColor    : LongInt     = DefaultTCurveColor;
                          aStyle    : LongInt     = DefaultTCurveStyle;
                          aCapacity : LongInt     = DefaultTCurveCapacity;
                          aStep     : LongInt     = DefaultTCurveStep);
var i:LongInt;
begin
 inherited Create;
 Exceptions:=false;
 myX:=nil;
 myY:=nil;
 myCount:=0;
 Step:=aStep;
 Capacity:=aCapacity;
 Count:=aCount;
 Name:=aName;
 Color:=aColor;
 Style:=aStyle;
 myComment:=NewText;
 myComment.Master:=@myComment;
 mySmartAddMarker:=Point2D(_Nan,_Nan);
 for i:=0 to Count-1 do XY[i]:=Point2D(i,0);
end;

destructor TCurve.Destroy;
begin
 Name:='';
 Capacity:=0;
 Kill(myComment);
 inherited Destroy;
end;

function TCurve.GetPX: PDoubleArray;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myX;
  Unlock;
 end else Result:=nil;
end;

function TCurve.GetPY: PDoubleArray;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myY;
  Unlock;
 end else Result:=nil;
end;

function TCurve.GetXY(Num:LongInt):TPoint2D;
begin
 if Assigned(Self) then begin
  Lock;
  if (Num>=0) and (Num<myCount) then begin
   Result.x:=myX[Num];
   Result.y:=myY[Num];
  end else begin
   Result.x:=0;
   Result.y:=0;
  end;
  Unlock;
 end else begin
  Result.x:=0;
  Result.y:=0;
 end;
end;

procedure TCurve.PutXY(Num:LongInt; const aPoint: TPoint2D);
begin
 if Assigned(Self) then begin
  Lock;
  if Num=myCount then InsertPoints(Num,aPoint.x,aPoint.y,1) else
  if (Num>=0) and (Num<myCount) then begin
   myX[Num]:=aPoint.x;
   myY[Num]:=aPoint.y;
  end;
  Unlock;
 end;
end;

function TCurve.GetCount:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myCount;
  Unlock;
 end else Result:=0;
end;

procedure TCurve.SetCount(NewCount:LongInt);
var OldCount:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  NewCount:=max(0,NewCount);
  if NewCount<>myCount then begin
   if NewCount>Capacity then Capacity:=AdjustBufferSize(NewCount,max(1,myStep));
   OldCount:=min(myCount,Capacity);
   myCount:=min(NewCount,Capacity);
   if myCount<OldCount then begin
    SafeFillChar(myX[myCount], (OldCount-myCount)*SizeOf(myX[0]), 0);
    SafeFillChar(myY[myCount], (OldCount-myCount)*SizeOf(myY[0]), 0);
   end else
   if myCount>OldCount then begin
    SafeFillChar(myX[OldCount], (myCount-OldCount)*SizeOf(myX[0]), 0);
    SafeFillChar(myY[OldCount], (myCount-OldCount)*SizeOf(myY[0]), 0);
   end;
  end;
  Unlock;
 end;
end;

function TCurve.GetCapacity:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=min(AllocSize(myX) div SizeOf(myX[0]),
              AllocSize(myY) div SizeOf(myY[0]));
   Unlock;
 end else Result:=0;
end;

procedure TCurve.SetCapacity(NewCapacity:LongInt);
var NewCount:LongInt;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   NewCapacity:=max(NewCapacity,0);
   NewCapacity:=min(NewCapacity,MaxNumDouble);
   if NewCapacity<>Capacity then begin
    NewCount:=min(myCount,NewCapacity);
    if NewCount<Capacity then begin
     SafeFillChar(myX[NewCount], (Capacity-NewCount)*SizeOf(myX[0]), 0);
     SafeFillChar(myY[NewCount], (Capacity-NewCount)*SizeOf(myY[0]), 0);
    end;
    Reallocate(Pointer(myX),NewCapacity*SizeOf(myX[0]));
    Reallocate(Pointer(myY),NewCapacity*SizeOf(myY[0]));
    myCount:=min(NewCount,Capacity);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E,'SetCapacity');
 end;
end;

function TCurve.GetStep:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myStep;
  Unlock;
 end else Result:=0;
end;

procedure TCurve.SetStep(NewStep:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  myStep:=max(0,NewStep);
  Unlock;
 end;
end;

function  TCurve.GetName:LongString;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myName;
  Unlock;
 end else Result:='';
end;

procedure TCurve.SetName(const NewName:LongString);
begin
 if Assigned(Self) then begin
  Lock;
  myName:=ExtractWord(1,NewName,ScanSpaces);
  Unlock;
 end;
end;

function  TCurve.GetComment:TText;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myComment;
  Unlock;
 end else Result:=nil;
end;

function TCurve.GetColor:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myColor;
  Unlock;
 end else Result:=0;
end;

procedure TCurve.SetColor(NewColor:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  myColor:=NewColor;
  Unlock;
 end;
end;

function TCurve.GetStyle:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myStyle;
  Unlock;
 end else Result:=0;
end;

procedure TCurve.SetStyle(NewStyle:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  myStyle:=NewStyle;
  Unlock;
 end;
end;

function TCurve.GetIsDynamic:Boolean;
begin
 Result:=(Step>0)
end;

function TCurve.GetIsStatic:Boolean;
begin
 Result:=(Step<=0)
end;

function TCurve.GetLimits:TRect2D;
begin
 Result:=Rect2D(0,0,0,0);
 if Assigned(Self) then begin
  Lock;
  Result:=Rect2D(ValueOfMin(myX[0],myCount),ValueOfMin(myY[0],myCount),
                 ValueOfMax(myX[0],myCount),ValueOfMax(myY[0],myCount));
  Unlock;
 end;
end;

function TCurve.GetLastPoint:TPoint2D;
begin
 with Result do
 if Assigned(Self) then begin
  Lock;
  if myCount>0 then begin
   x:=myX[myCount-1];
   y:=myY[myCount-1];
  end else begin
   x:=0;
   y:=0;
  end;
  Unlock;
 end else begin
  x:=0;
  y:=0;
 end;
end;

function TCurve.GetSmartAddMarker:TPoint2D;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=mySmartAddMarker;
  Unlock;
 end else Result:=Point2D(_Nan,_Nan);
end;

procedure TCurve.SetSmartAddMarker(const aMarker:TPoint2D);
begin
 if Assigned(Self) then begin
  Lock;
  mySmartAddMarker:=aMarker;
  Unlock;
 end;
end;

procedure TCurve.DeletePoints(Num,NumPoints:LongInt);
var Tail:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if (Num>=0) and (Num<myCount) then begin
   NumPoints:=min(NumPoints,myCount-Num);
   if NumPoints>0 then begin
    Tail:=myCount-Num-NumPoints;
    if Tail>0 then begin
     SafeMove(myX[Num+NumPoints], myX[Num], Tail*SizeOf(myX[0]));
     SafeMove(myY[Num+NumPoints], myY[Num], Tail*SizeOf(myY[0]));
    end;
    SafeFillChar(myX[myCount-NumPoints], NumPoints*SizeOf(myX[0]),0);
    SafeFillChar(myY[myCount-NumPoints], NumPoints*SizeOf(myY[0]),0);
    dec(myCount,NumPoints);
   end;
  end;
  Unlock;
 end;
end;

procedure TCurve.DeletePoint(Num:LongInt);
begin
 DeletePoints(Num,1);
end;

procedure TCurve.InsertPoints(Num:LongInt; const aX,aY:array of Double; NumPoints:LongInt);
var Tail:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if (Num>=0) and (Num<=myCount) and (NumPoints>0) then begin
   Capacity:=max(Capacity,AdjustBufferSize(myCount+NumPoints,max(1,myStep)));
   if Capacity>=myCount+NumPoints then begin
    Tail:=myCount-Num;
    if Tail>0 then begin
     SafeMove(myX[Num], myX[Num+NumPoints], Tail*SizeOf(myX[0]));
     SafeMove(myY[Num], myY[Num+NumPoints], Tail*SizeOf(myY[0]));
    end;
    SafeMove(aX[0], myX[Num], NumPoints*SizeOf(myX[0]));
    SafeMove(aY[0], myY[Num], NumPoints*SizeOf(myY[0]));
    inc(myCount,NumPoints);
   end;
  end;
  Unlock;
 end;
end;

procedure TCurve.InsertPoint(Num:LongInt; const aX,aY:Double);
begin
 InsertPoints(Num,aX,aY,1);
end;

procedure TCurve.AddPoints(const aX,aY:array of Double; NumPoints:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  InsertPoints(myCount,aX,aY,NumPoints);
  Unlock;
 end;
end;

procedure TCurve.AddPoint(const aX,aY:Double);
begin
 if Assigned(Self) then begin
  Lock;
  InsertPoints(myCount,aX,aY,1);
  Unlock;
 end;
end;

procedure TCurve.SmartAddPoint(const aX,aY  : Double;
                                     Flags  : Cardinal = afDefault;
                                     Action : TCurveAddPointAction = nil;
                                     Custom : Pointer  = nil);
var
 Ignore : Boolean;
begin
 if Assigned(Self) then begin
  Lock;
  Ignore:= ((Flags and afIgnoreNanX   <> 0) and isNan(aX)) or
           ((Flags and afIgnoreNanY   <> 0) and isNan(aY)) or
           ((Flags and afIgnoreInfX   <> 0) and isInf(aX)) or
           ((Flags and afIgnoreInfY   <> 0) and isInf(aY));
  if myCount>0 then Ignore:=Ignore or
           ((Flags and afIgnoreLessX  <> 0) and (aX<myX[myCount-1])) or
           ((Flags and afIgnoreEqualX <> 0) and (aX=myX[myCount-1]));
  if not Ignore then
  case myCount of
   0  : InsertPoints(myCount,aX,aY,1);
   1  : if (Flags and afPackDublicatesX <> 0) and (aX = myX[myCount-1])
        then myY[myCount-1]:=aY
        else InsertPoints(myCount,aX,aY,1);
   else if (Flags and afPackDublicatesX <>0 ) and (aX = myX[myCount-1])
        then myY[myCount-1]:=aY
        else
        if (Flags and afPackDublicatesY <> 0) and (aY = myY[myCount-1]) and (aY = myY[myCount-2])
        then myX[myCount-1]:=aX
        else InsertPoints(myCount,aX,aY,1);
  end;
  Unlock;
  if not Ignore then begin
   if (Flags and afUpdateMarker <> 0) and isNan(mySmartAddMarker)
   then mySmartAddMarker:=Point2D(aX,aY);
   if Assigned(Action) then
   try
    Action(Self,Custom);
   except
    on E:Exception do ErrorFound(E,'SmartAddPoint');
   end;
  end;
 end;
end;

procedure TCurve.ClearHistory(aHistLen:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  aHistLen:=max(0,aHistLen);
  if Count>aHistLen then DeletePoints(0,Count-aHistLen);
  Unlock;
 end;
end;

function TCurve.Clone(Num:LongInt=0; NumPoints:LongInt=MaxNumDouble):TCurve;
begin
 Result:=nil;
 if Assigned(Self) then begin
  Lock;
  Num:=max(Num,0);
  NumPoints:=max(0,min(NumPoints,Count-Num));
  Result:=NewCurve(NumPoints,Name,Color,Style,Capacity,Step);
  if Result.Ok and (Result.Count=NumPoints) then begin
   if NumPoints>0 then Result.AssignData(myX[Num],myY[Num],NumPoints);
   Result.AssignComment(Comment);
  end else Kill(Result);
  Unlock;
 end;
end;

function TCurve.GetPoints(Num:LongInt; var aX,aY:array of Double; NumPoints:LongInt):LongInt;
begin
 Result:=0;
 if Assigned(Self) and (NumPoints>0) then begin
  Lock;
  if (Num>=0) and (Num<myCount) then begin
   NumPoints:=max(0,min(NumPoints,myCount-Num));
   if NumPoints>0 then begin
    SafeMove(myX[Num], aX[0], NumPoints*SizeOf(myX[0]));
    SafeMove(myY[Num], aY[0], NumPoints*SizeOf(myY[0]));
   end;
   Result:=NumPoints;
  end;
  Unlock;
 end;
end;

procedure TCurve.Assign(Source:TCurve);
begin
 if Assigned(Self) then begin
  if Assigned(Source) then begin
   Lock;
   Source.Lock;
   Capacity:=Source.Capacity;
   AssignData(Source.PX[0],Source.PY[0],Source.Count);
   Step:=Source.Step;
   Name:=Source.Name;
   AssignComment(Source.Comment);
   Color:=Source.Color;
   Style:=Source.Style;
   Source.Unlock;
   Unlock;
  end else begin
   Lock;
   Count:=0;
   Comment.Count:=0;
   Unlock;
  end;
 end;
end;

procedure TCurve.Catenate(Source:TCurve; CatComment:Boolean=false);
begin
 if Assigned(Self) then begin
  if Assigned(Source) then begin
   Lock;
   Source.Lock;
   CatenateData(Source.PX[0],Source.PY[0],Source.Count);
   if CatComment then CatenateComment(Source.Comment);
   Source.Unlock;
   Unlock;
  end;
 end;
end;

procedure TCurve.AssignData(const XData,YData:array of Double; NumPoints:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  Count:=0;
  InsertPoints(0,XData[0],YData[0],NumPoints);
  Unlock;
 end;
end;

procedure TCurve.CatenateData(const XData,YData:array of Double; NumPoints:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  InsertPoints(Count,XData[0],YData[0],NumPoints);
  Unlock;
 end;
end;

procedure TCurve.AssignComment(aComment:TText);
begin
 if Assigned(Self) then begin
  Lock;
  Comment.Count:=0;
  Comment.Concat(aComment);
  Unlock;
 end;
end;

procedure TCurve.CatenateComment(aComment:TText);
begin
 if Assigned(Self) then begin
  Lock;
  Comment.Concat(aComment);
  Unlock;
 end;
end;

procedure TCurve.Move(dx,dy:Double);
var i:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if dx<>0 then for i:=0 to myCount-1 do myX[i]:=myX[i]+dx;
  if dy<>0 then for i:=0 to myCount-1 do myY[i]:=myY[i]+dy;
  Unlock;
 end;
end;

procedure TCurve.Mult(mx,my:Double);
var i:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if mx<>1 then for i:=0 to myCount-1 do myX[i]:=myX[i]*mx;
  if my<>1 then for i:=0 to myCount-1 do myY[i]:=myY[i]*my;
  Unlock;
 end;
end;

procedure TCurve.AddLn(const s:LongString);
begin
 Lock;
 Comment.AddLn(s);
 Unlock;
end;

function TCurve.GetIndexAt(t:Double):Integer;
begin
 if Assigned(Self) and (myCount>0) then begin
  Lock;
  Result:=FindIndex(myCount,myX[0],t);
  Unlock;
 end else Result:=0;
end;

function TCurve.Interpolate(t:Double):Double;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=LinearInterpolation(myX[0],myY[0],myCount,t);
  Unlock;
 end else Result:=0;
end;

function smKern(x:Double; CustomData:Pointer):Double;
var k1,k2:Integer;
begin
 x:=abs(x);
 if x>1 then Result:=0 else begin
  Result:=1;
  k1:=PointerToPtrInt(CustomData) mod 10;
  k2:=PointerToPtrInt(CustomData) div 10;
  case k1 of
   0    : Result:=1;
   1    : Result:=1-x;
   2    : Result:=1-sqr(x);
   3..9 : Result:=1-IntPower(x,k1);
  end;
  case k2 of
   0    : Result:=1;
   1    : ;
   2    : Result:=sqr(Result);
   3..9 : Result:=IntPower(Result,k2);
  end;
 end;
end;

function TCurve.Smooth(t:Double; Window:Double; Power,K1,K2:Integer):Double;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=WindowedKernelSmoothing(myX[0], myY[0], myCount, t, Window, Power,
                                  smKern, PtrIntToPointer((k1 mod 10)+10*(k2 mod 10)));
  Unlock;
 end else Result:=0;
end;

function TCurve.Mediana(i,j:Integer; var aIndex:Integer; var aValue:Double; SortMethod:TSortMethod=smQuickSort):Boolean;
var Index:PIntegerArray; np:Integer; SmallIndex:array[0..31] of Integer;
begin
 Result:=false;
 np:=j-i+1;
 if Assigned(Self) and (np>0) then begin
  Lock;
  if (i>=0) and (i<myCount) and (j>=0) and (j<myCount) then begin
   if i=j then begin
    Result:=true;
    aIndex:=i;
    aValue:=myY[aIndex];
   end else begin
    if np<=High(SmallIndex)-Low(SmallIndex)+1
    then Index:=@SmallIndex
    else Index:=Allocate(np*SizeOf(Index[0]));
    if SortIndex(np, myY[i], Index, SortMethod)<>nil then begin
     Result:=true;
     aIndex:=i+Index[(np-1) shr 1];
     aValue:=myY[aIndex];
    end;
    if Index<>@SmallIndex then Deallocate(Pointer(Index));
   end;
  end;
  Unlock;
 end;
end;

function TCurve.Flags(AbsEps : Double  = DefaultTCurveAbsEps;
                      RelEps : Double  = DefaultTCurveRelEps;
                      Small  : Integer = DefaultTCurveSmall):LongInt;
var i:LongInt; xi,yi,xi1,yi1,dx,dy,dx1,dy1,EpsX,EpsY:Double;
begin
 Result:=0;
 if Ok then begin
  Lock;
  if Count=0         then Result:=Result or cfNoData;
  if Comment.Count=0 then Result:=Result or cfNoComment;
  if Count<=Small    then Result:=Result or cfTooSmall;
  with Limits do begin
   EpsX:=Precision(AbsEps,RelEps,abs(a.x)+abs(b.x));
   EpsY:=Precision(AbsEps,RelEps,abs(a.y)+abs(b.y));
  end;
  xi1:=0; yi1:=0; dx1:=0; dy1:=0;
  for i:=0 to Count-1 do begin
   xi:=myX[i];
   yi:=myY[i];
   if isNaN(xi)     then Result:=Result or cfNaNX;
   if isNaN(yi)     then Result:=Result or cfNaNY;
   if isInf(xi)     then Result:=Result or cfInfX;
   if isInf(yi)     then Result:=Result or cfInfY;
   if abs(xi)<=EpsX then Result:=Result or cfHaveZeroX;
   if abs(yi)<=EpsY then Result:=Result or cfHaveZeroY;
   if xi>0          then Result:=Result or cfHavePozitivX;
   if yi>0          then Result:=Result or cfHavePozitivY;
   if xi<0          then Result:=Result or cfHaveNegativX;
   if yi<0          then Result:=Result or cfHaveNegativY;
   if i>0 then begin
    dx:=xi-xi1;
    dy:=yi-yi1;
    if dx<0         then Result:=Result or cfNotSortedX;
    if dy<0         then Result:=Result or cfNotSortedY;
    if abs(dx)<EpsX then Result:=Result or cfDuplicatesX;
    if abs(dy)<EpsY then Result:=Result or cfDuplicatesY;
    if i=1 then begin
     dx1:=dx;
     dy1:=dy;
    end;
    if abs(dx-dx1)>EpsX then Result:=Result or cfNotEquiDistantX;
    if abs(dy-dy1)>EpsY then Result:=Result or cfNotEquiDistantY;
   end;
   xi1:=xi;
   yi1:=yi;
  end;
  Unlock;
 end else Result:=cfInvalid;
end;

function TCurve.HasEquivalentData(Curve  : TCurve;
                                  Mode   : Integer = 1; { 1=X, 2=Y }
                                  AbsEps : Double  = DefaultTCurveAbsEps;
                                  RelEps : Double  = DefaultTCurveRelEps):Boolean;
var i:LongInt; eps,p1,p2:TPoint2D;
begin
 Result:=false;
 if Self.Ok and Curve.Ok and (Self.Count=Curve.Count) then begin
  Result:=true;
  with RectUnion(Self.Limits,Curve.Limits) do
  eps:=Point2D(Precision(AbsEps,RelEps,abs(a.x)+abs(b.x)),
               Precision(AbsEps,RelEps,abs(a.y)+abs(b.y)));
  for i:=0 to Count-1 do begin
   p1:=Self[i];
   p2:=Curve[i];
   if (Mode and 1<>0) and (abs(p1.x-p2.x)>eps.x) then begin
    Result:=false;
    break;
   end;
   if (Mode and 2<>0) and (abs(p1.y-p2.y)>eps.y) then begin
    Result:=false;
    break;
   end;
  end;
 end;
end;

function TCurve.GetTable(aText   : TText;
                         WX      : Integer = 0;
                         DX      : Integer = 16;
                         WY      : Integer = 0;
                         DY      : Integer = 16 ) : TText;
var i:LongInt; p:TPoint2D;
begin
 Result:=aText;
 if Assigned(Self) and Assigned(aText) then begin
  Lock;
  for i:=0 to Count-1 do begin
   p:=Self[i];
   aText.Addln(Format('%*.*g %*.*g',[WX,DX,p.x,WY,DY,p.y]));
  end;
  Unlock;
 end;
end;

procedure TCurve.ReadTable(Table:TText; XColumn,YColumn:Integer; Delims:TCharSet=[' ',',',ASCII_HT]);
var i:Integer; s:LongString; x,y:Double;
begin
 if Assigned(Self) then begin
  Count:=0;
  if Assigned(Table) and ((XColumn>0) or (YColumn>0)) then
  for i:=0 to Table.Count-1 do begin
   s:=Table[i];
   if XColumn>0 then begin
    if not Str2Real(ExtractWord(XColumn,s,Delims),x) then continue;
   end else x:=Count;
   if YColumn>0 then begin
    if not Str2Real(ExtractWord(YColumn,s,Delims),y) then continue;
   end else y:=Count;
   AddPoint(x,y);
  end;
 end;
end;

 {
 *****************
 Utility functions
 *****************
 }
function NewCurve(aCount    : LongInt     = 0;
            const aName     : LongString  = '';
                  aColor    : LongInt     = DefaultTCurveColor;
                  aStyle    : LongInt     = DefaultTCurveStyle;
                  aCapacity : LongInt     = DefaultTCurveCapacity;
                  aStep     : LongInt     = DefaultTCurveStep
                          ) : TCurve;
begin
 Result:=nil;
 try
  Result:=TCurve.Create(aCount,aName,aColor,aStyle,aCapacity,aStep);
 except
  on E:Exception do BugReport(E,nil,'NewCurve');
 end;
end;

procedure Kill(var TheObject:TCurve); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

function NewCurveCopy(Curve:TCurve; First:LongInt=0; Last:LongInt=MaxNumDouble-1):TCurve;
begin
 Result:=Curve.Clone(First,Last-First+1);
end;

function NewCurveCatenation(Curve1,Curve2:TCurve):TCurve;
begin
 Result:=Curve1.Clone;
 Result.Catenate(Curve2);
end;

function NewCurveExtractX(Curve:TCurve):TCurve;
var i:LongInt;
begin
 Result:=Curve.Clone;
 for i:=0 to Result.Count-1 do Result[i]:=Point2D(i,Result[i].y);
end;

function NewCurveExtractY(Curve:TCurve):TCurve;
var i:LongInt;
begin
 Result:=Curve.Clone;
 for i:=0 to Result.Count-1 do Result[i]:=Point2D(i,Result[i].x);
end;

function NewCurveInverted(Curve:TCurve):TCurve;
var i:Integer; p:TPoint2D; d:Double;
begin
 Result:=Curve.Clone;
 for i:=0 to Result.Count-1 do begin
  p:=Result[i];
  d:=p.x;
  p.x:=p.y;
  p.y:=d;
  Result[i]:=p;
 end;
end;

function NewCurveIntegral(Curve:TCurve; AFreeConst:Double=0):TCurve;
var i:LongInt; r,c,p:TPoint2D;
begin
 Result:=Curve.Clone;
 p:=Point2d(0,0);
 for i:=0 to Result.Count-1 do begin
  c:=Result[i];
  r.x:=c.x;
  if i=0 then r.y:=AFreeConst else r.y:=r.y+0.5*(c.y+p.y)*(c.x-p.x);
  Result[i]:=r;
  p:=c;
 end;
end;

function NewCurveDerivative(Curve:TCurve):TCurve;
label Quit,Error;
var dxR,dyR,dyL,dxL:Double; i:LongInt; c:TCurve;
begin
 c:=Curve.Clone;
 Result:=c.Clone;
 if Result.Count<4 then goto Error;
 dxR:=c[1].x-c[0].x;
 dyR:=c[1].y-c[0].y;
 if dxR=0 then goto Error;
 Result[0]:=Point2D(c[0].x, dyR/dxR);
 dxL:=c[c.Count-1].x-c[c.Count-2].x;
 dyL:=c[c.Count-1].y-c[c.Count-2].y;
 if dxL=0 then goto Error;
 Result[c.Count-1]:=Point2D(c[c.Count-1].x,dyL/dxL);
 for i:=1 to c.Count-2 do begin
  dxL:=c[i].x-c[i-1].x;
  dyL:=c[i].y-c[i-1].y;
  dxR:=c[i+1].x-c[i].x;
  dyR:=c[i+1].y-c[i].y;
  if (dxL=0) or (dxR=0) then goto Error;
  Result[i]:=Point2D(c[i].x,0.5*(dyR/dxR+dyL/dxL));{полусумма левой и правой производной}
 end;
 goto Quit;
Error:
 Kill(Result);
Quit:
 Kill(c);
end;

function NewCurveByFormula(NumPoints:LongInt; tmin,tmax:Double; const Formula:LongString):TCurve;
var i:LongInt; ee:TExpressionEvaluator; x,y,t:Double; Success:Boolean;
begin
 Result:=NewCurve(0,'Formula');
 if Result.Ok and (NumPoints>1) then
 try
  ee:=NewExpressionEvaluator;
  try
   ee.Script:=Formula;
   for i:=0 to NumPoints-1 do begin
    t:=tmin+(tmax-tmin)*i/(NumPoints-1);
    Success:=true;
    Success:=Success and ee.SetValue('t',t);
    Success:=Success and (ee.RunScript=ee_Ok);
    Success:=Success and ee.GetValue('x',x);
    Success:=Success and ee.GetValue('y',y);
    Success:=Success and not isNanOrInf(x);
    Success:=Success and not isNanOrInf(y);
    if Success then Result.AddPoint(x,y) else begin
     Kill(Result);
     break;
    end;
   end;
  finally
   Kill(ee);
  end;
 except
  on E:Exception do BugReport(E,nil,'NewCurveByFormula');
 end;
end;

function NewCurveExceptParametr(CurveX : TCurve;
                                CurveY : TCurve;
                                AbsEps : Double = DefaultTCurveAbsEps;
                                RelEps : Double = DefaultTCurveRelEps
                                     ) : TCurve;
var i:LongInt; c:TCurve;
begin
 c:=CurveX.Clone;
 Result:=CurveY.Clone;
 if c.Ok and Result.Ok and Result.HasEquivalentData(c,1,AbsEps,RelEps) then begin
  Result.Comment.Count:=0;
  for i:=0 to Result.Count-1 do Result[i]:=Point2D(c[i].y,Result[i].y);
 end else Kill(Result);
 Kill(c);
end;

function NewCurveMedianFiltr(Curve  : TCurve;
                             Width  : Integer = 1;
                             AbsEps : Double  = DefaultTCurveAbsEps;
                             RelEps : Double  = DefaultTCurveRelEps
                                  ) : TCurve;
var i:LongInt; Index:PIntegerArray; c:TCurve;  Mediana,Eps:Double;
begin
 c:=Curve.Clone;
 Result:=c.Clone; Index:=nil;
 if Result.Ok and (Width>0) and (Result.Count>2*Width+1) then begin
  with C.Limits do Eps:=Precision(AbsEps,RelEps,abs(b.y-a.y));
  Index:=Allocate((2*Width+1)*SizeOf(Index[0]));
  if Assigned(Index) then begin
   for i:=Width to c.Count-1-Width do begin
    SortIndex(Width*2+1,c.PY[i-Width],Index,smQuickSort);
    Mediana:=c.PY[i-Width+Index[Width]];
    if abs(Mediana-c.PY[i])>=Eps then Result[i]:=Point2D(c[i].x,Mediana);
   end
  end else Kill(Result);
  Deallocate(Pointer(Index));
 end else Kill(Result);
 Kill(C);
end;

 {
 Внутренние процедуры для сортировки
 }
type
 TSortRec = record
  Curve : TCurve;
  Flags : Integer;
 end;

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

procedure SwapPoints(Data:Pointer; i,j:Integer);
var P:TPoint2D;
begin
 with TSortRec(Data^) do begin
  P:=Curve[i];
  Curve[i]:=Curve[j];
  Curve[j]:=P;
 end;
end;

function ComparePoints(Data,Key1,Key2:Pointer):Integer;
var k1,k2:TPoint2D; p1,p2:record Pri,Sec:Double; end;
begin
 with TSortRec(Data^) do begin
  k1:=Curve[PointerToPtrInt(Key1)];
  k2:=Curve[PointerToPtrInt(Key2)];
  if Flags and sfPrimaryY=0 then begin {x-primary key}
   if Flags and sfReversPrimary=0 then begin
    p1.Pri:=k1.x;
    p2.Pri:=k2.x;
   end else begin
    P1.Pri:=k2.x;
    P2.Pri:=k1.x;
   end;
   if Flags and sfReversSecondary=0 then begin
    p1.Sec:=k1.y;
    p2.Sec:=k2.y;
   end else begin
    p1.Sec:=k2.y;
    p2.Sec:=k1.y;
   end;
  end else begin                            {y-primary key}
   if Flags and sfReversPrimary=0 then begin
    p1.Pri:=k1.y;
    p2.Pri:=k2.y;
   end else begin
    p1.Pri:=k2.y;
    p2.Pri:=k1.y;
   end;
   if Flags and sfReversSecondary=0 then begin
    p1.Sec:=k1.x;
    p2.Sec:=k2.x;
   end else begin
    p1.Sec:=k2.x;
    p2.Sec:=k1.x;
   end;
  end;
  if p1.Pri<p2.Pri then Result:=-1 else
  if p1.Pri>p2.Pri then Result:=+1 else
  if p1.Sec<p2.Sec then Result:=-1 else
  if p1.Sec>p2.Sec then Result:=+1 else Result:= 0;
 end;
end;


 {
 Упаковка предварительно отсортированного массива.
 При упаковке точки, имеющие координаты X, отличающиеся не более чем
 на NearlyZero друг от друга, сжимаются в одну точку.
 }
function PackArray(var x,y:array of Double; N:LongInt; Eps:Double):LongInt;
var i,sumn,Last:LongInt; sumx,sumy:Double; px,py:PDoubleArray;
begin
 Result:=0;
 px:=nil; py:=nil;
 px:=Allocate(N*SizeOf(px[0]));
 py:=Allocate(N*SizeOf(py[0]));
 if Assigned(px) and Assigned(py) then begin
  Eps:=abs(Eps);
  sumx:=0;
  sumy:=0;
  sumn:=0;
  Last:=0;
  for i:=0 to N-1 do begin
   if (sumn>0) and (abs(x[i]-x[Last])>Eps) then begin
    px[Result]:=sumx/sumn;
    py[Result]:=sumy/sumn;
    inc(Result);
    sumx:=0;
    sumy:=0;
    sumn:=0;
    Last:=i;
   end;
   sumx:=sumx+x[i];
   sumy:=sumy+y[i];
   sumn:=sumn+1;
  end;
  px[Result]:=sumx/sumn;
  py[Result]:=sumy/sumn;
  inc(Result);
  for i:=0 to Result-1 do begin
   x[i]:=px[i];
   y[i]:=py[i];
  end;
 end;
 Deallocate(Pointer(px));
 Deallocate(Pointer(py));
end;

function NewCurveSorted(Curve  : TCurve;
                        Flags  : Integer     = 0;
                        AbsEps : Double      = DefaultTCurveAbsEps;
                        RelEps : Double      = DefaultTCurveRelEps;
                        Method : TSortMethod = smShellSort
                             ) : TCurve;
const
 prim : array[boolean] of char=('x','y');
 revs : array[boolean] of char=('>','<');
var
 SortRec : TSortRec;
begin
 Result:=Curve.Clone;
 if Result.Ok and (Result.Count>0) then begin
  SortRec.Curve:=Result;
  SortRec.Flags:=Flags;
  if Sort(Result.Count,@SortRec,ComparePoints,KeyOfPoints,SwapPoints,nil,Method)
  then begin
   Result.Comment.Addln('!Sort('+Prim[Flags and sfPrimaryY<>0]+','+
                                 Revs[Flags and sfReversPrimary<>0]+','+
                                 Revs[Flags and sfReversSecondary<>0]+')');
   if Flags and sfPack<>0 then begin
    RelEps:=max(1e3*MachEps,RelEps);
    with Result.Limits do
    if Flags and sfPrimaryY=0
    then Result.Count:=PackArray(Result.PX[0],Result.PY[0],Result.Count,
                                 Precision(AbsEps,RelEps,abs(b.x-a.x)))
    else Result.Count:=PackArray(Result.PY[0],Result.PX[0],Result.Count,
                                 Precision(AbsEps,RelEps,abs(b.y-a.y)));
    Result.Comment.Addln('!Pack('+Prim[Flags and sfPrimaryY<>0]+','+f2s(AbsEps)+','+f2s(RelEps)+')');
   end;
  end else Kill(Result);
 end else Kill(Result);
end;

 {
 *************************
 TCurveList implementation
 *************************
 }
function TCurveList.GetCurve(i:LongInt):TCurve;
begin
 Result:=TCurve(Items[i]);
end;

procedure TCurveList.PutCurve(i:LongInt; c:TCurve);
begin
 Items[i]:=TObject(c);
end;

constructor TCurveList.Create(aOwns:Boolean);
begin
 inherited Create(aOwns);
end;

destructor  TCurveList.Destroy;
begin
 inherited Destroy;
end;

procedure TCurveList.ClearHistory(aHistLen:LongInt=0);
var i:Integer;
begin
 if Ok then begin
  Lock;
  for i:=0 to Count-1 do Curve[i].ClearHistory(aHistLen);
  Unlock;
 end;
end;

function TCurveList.Find(aName:LongString):TCurve;
var i:Integer;
begin
 Result:=nil;
 aName:=UnifyAlias(aName);
 if Ok and IsNonEmptyStr(aName) then begin
  Lock;
  for i:=0 to Count-1 do if IsSameText(UnifyAlias(Curve[i].Name),aName) then begin
   Result:=Curve[i];
   Break;
  end;
  Unlock;
 end;
end;

function TCurveList.GetList(aText:TText):TText;
var i:Integer;
begin
 Result:=aText;
 if Ok then begin
  Lock;
  for i:=0 to Count-1 do aText.AddLn(Curve[i].Name);
  Unlock;
 end;
end;

function TCurveList.FormatTable(const Fmt       : LongString;
                                      WriteProc : TCurveListWriteTableProc;
                                      Custom    : Pointer):Boolean;
const
 ncmax    = 64;
 fmlen    = 9;
var
 cd   : packed record                            { column description }
  c   : packed array[1..ncmax] of char;          { i=index, x, y      }
  n   : packed array[1..ncmax] of integer;       { curve number       }
  fmt : packed array[1..ncmax] of string[fmlen]; { format string      }
 end;
 nc : Integer;
 np : Integer;
 wd : LongString;
 i  : Integer;
 p  : Integer;
 c  : TCurve;
 v  : Double;
begin
 Result:=false;
 if Ok then
 try
  Lock;
  try
   nc:=0;
   np:=0;
   for i:=1 to min(ncmax,WordCount(Fmt,ScanSpaces)) do begin
    nc:=i;
    wd:=LoCaseStr(ExtractWord(i,Fmt,ScanSpaces));
    if StrFetch(wd,1) in ['i','x','y']
    then cd.c[i]:=StrFetch(wd,1)
    else RAISE EConvertError.Create(RusEng('Ошибка форматирования!','Format error!'));
    system.Delete(wd,1,1);
    p:=pos('%',wd);
    if p>0 then begin
     cd.fmt[i]:=copy(wd,p,min(length(wd)-p+1,fmlen));
     if not (cd.fmt[i][length(cd.fmt[i])] in ['f','g'])
     then RAISE EConvertError.Create(RusEng('Ошибка форматирования!','Format error!'));
     if length(cd.fmt[i])>2 then
     if not Str2Real(copy(cd.fmt[i],2,length(cd.fmt[i])-2),v)
     then RAISE EConvertError.Create(RusEng('Ошибка форматирования!','Format error!'));
     wd:=copy(wd,1,p-1);
    end else begin
     cd.fmt[i]:='%.15g';
    end;
    v:=0;
    format(cd.fmt[i],[v]);
    if not Str2Int(wd,cd.n[i]) then RAISE EConvertError.Create(RusEng('Ошибка форматирования!','Format error!'));
    dec(cd.n[i]);
    if Cardinal(cd.n[i])>=Cardinal(Count) then RAISE EConvertError.Create(RusEng('Ошибка форматирования!','Format error!'));
    np:=max(np,Self[cd.n[i]].Count);
   end;
   for p:=0 to np-1 do begin
    for i:=1 to nc do begin
     c:=Self[cd.n[i]];
     if p>=c.Count then v:=_Nan else
     case cd.c[i] of
      'i': v:=p;
      'x': v:=c[p].x;
      'y': v:=c[p].y;
      else v:=_Nan;
     end;
     WriteProc(cd.fmt[i],v,Custom);
    end;
    WriteProc(EOL,_Nan,Custom);
   end;
   Result:=true;
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'FormatTable');
 end;
end;

 {
 *******************
 TCurveList utilites
 *******************
 }
function NewCurveList(aOwns:Boolean):TCurveList;
begin
 Result:=nil;
 try
  Result:=TCurveList.Create(aOwns);
 except
  on E:Exception do BugReport(E,nil,'NewCurveList');
 end;
end;

procedure Kill(var TheObject:TCurveList); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

 {
 ****************************
 ReadCurveList implementation
 ****************************
 }
procedure ReadCurveDetails(const IniFile:LongString; Curve:TCurve);
var P:PChar; i:LongInt; s,Section:LongString;
var RangeX : packed record a,b:Double; end;
begin
 if Assigned(Curve) then begin
  {чтение параметров}
  RangeX.a:=0; RangeX.b:=0;
  Section:=ExtractTextSection(IniFile,UnifySection(Curve.Name),efConfig);
  if ScanVarRecord(svConfig,PChar(Section),'RangeX%f;%f',RangeX)<>nil then begin
   if Curve.Count>1 then
   for i:=0 to Curve.Count-1 do
   with RangeX do Curve[i]:=Point2D(a+(b-a)*i/(Curve.Count-1),0);
  end;
  Section:=''; s:='';
  {чтение раздела комментариев}
  Section:=ExtractTextSection(IniFile,UnifySection(Curve.Name),efAsIs);
  P:=StrPass(ScanVarAlpha(svConfig,PChar(Section),'Notice%a',s),[ASCII_CR,ASCII_LF]);
  if Assigned(P) and IsSameText(s,'Text') then
  while Assigned(P) do begin
   P:=StrPass(ScanVarString(svAsIs,P,'%s',s),[ASCII_CR,ASCII_LF]);
   if Assigned(P) then begin
    if (PosI('End',s)>0) and (PosI('Notice',s)>0) then Break;
    Curve.Addln(s);
   end;
  end;
  Section:='';
 end;
end;

procedure ScanLine(const FileName,Line:LongString; Count:SizeInt; var Terminate:Boolean; CustomData:Pointer);
var Sect:LongString; List:TText;
begin
 List:=TText(CustomData); Sect:='';
 if ExtractSectionTitle(Line,Sect) then
 if (List.FindLine(Sect)<0) then List.Addln(Sect);
end;

function ReadListOfSections(const FileName:LongString):TText;
begin
 Result:=NewText;
 if ForEachTextLine(FileName,ScanLine,Result)<>0 then Result.Count:=0;
end;

type
 TRCLRec = record
  SecList  : TText;
  CurList  : TCurveList;
  IniFile  : LongString;
 end;

procedure AddCurve(Index:LongInt; const TextLine:LongString; var Terminate:Boolean; CustomData:Pointer);
var Curve:TCurve; i,Color,Marker,Line,Leng,Step:LongInt;
begin
 with TRCLRec(CustomData^) do begin
  if IsSameText(ExtractWord(2,TextLine,ScanSpaces),'CURVE') then begin
   if not Str2Long(ExtractWord(3,TextLine,ScanSpaces),Leng)   then Leng:=0;
   if not Str2Long(ExtractWord(4,TextLine,ScanSpaces),Step)   then Step:=DefaultTCurveStep;
   if not Str2Long(ExtractWord(5,TextLine,ScanSpaces),Color)  then Color:=CgaColorByName(ExtractWord(5,TextLine,ScanSpaces));
   if not Str2Long(ExtractWord(6,TextLine,ScanSpaces),Marker) then Marker:=DefaultTCurveMarker;
   if not Str2Long(ExtractWord(7,TextLine,ScanSpaces),Line)   then Line:=DefaultTCurveLine;
   if Color in [0..15] then Color:=CgaToRGBColor(Color);
   Curve:=NewCurve(Leng,ExtractWord(1,TextLine,ScanSpaces),Color,(Marker and 15)+(Line and 15)*16,Step,Step);
   if Assigned(Curve) then begin
    for i:=0 to SecList.Count-1 do
    if IsSameText(UnifySection(Curve.Name),UnifyAlias(SecList[i])) then begin
     ReadCurveDetails(IniFile,Curve);
     Break;
    end;
    if CurList.Find(Curve.Name)=nil then CurList.Add(Curve) else Kill(Curve);
   end;
  end;
 end;
end;

function ReadCurveList(List:TCurveList; const IniFile,SectionName:LongString):TCurveList;
var RCLRec:TRCLRec; P:TText; aIniFile:LongString;
begin
 Result:=List;
 if Assigned(List) then
 try
  aIniFile:=UnifyFileAlias(IniFile);
  P:=ExtractListSection(aIniFile,UnifySection(SectionName),efConfig);
  if Assigned(P) then
  try
   RCLRec:=Default(TRCLRec);
   try
    RCLRec.IniFile:=StringBuffer(aIniFile);
    RCLRec.CurList:=List;
    RCLRec.SecList:=ReadListOfSections(aIniFile);
    P.ForEach(AddCurve,@RCLRec);
   finally
    Kill(RCLRec.SecList);
    RCLRec.IniFile:='';
   end;
  finally
   Kill(P);
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadCurveList');
 end;
end;

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

procedure Init_crw_curves;
begin
end;

procedure Free_crw_curves;
begin
end;

initialization

 Init_crw_curves;

finalization

 Free_crw_curves;

end.

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

