{ Composed Calibration creator object }{v0.61}
unit CompCalu;
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
uses
  SysUtils, Classes,
  UlanType, ULObju, 
  ULPType, ULPObju, ULPRType, ULPRObju,
  Spectrum;

type
  TCompCal = class(TObject)
  private
    FFileName: string;
    FData: TAcqData;
    FSpec: TSpectrum;{ created for FData }
    FPeaks: TList;{ pointers to childs of FData.ULP = FSpec.Peaks }
    FPeakAddCounts: TList;{ keeps track of a number of calculations (additions)
      made to the peak at FPeaks with the same index }
    procedure PeakAdd(sp: TULPRObj);
    procedure PeakCalc(cp, sp: TULPRObj);
    procedure DataCalcFinish;
  public
    constructor Create(AFileName: string); reintroduce;
    { Include AAcqData to calculation }
    procedure DataCalc(AAcqData: TAcqData);

    destructor Destroy; override;
    property FileName: string read FFileName;
  end;

implementation

constructor TCompCal.Create(AFileName: string);
begin
  inherited Create;
  FFileName := AFileName;
  CreateOrOpenDataFile(FFileName, FData);
  FData.ULP.Clear;
  FData.SpectrumGet(FSpec);
  FPeaks := TList.Create;
  FPeakAddCounts := TList.Create;
end;

procedure TCompCal.DataCalcFinish;
var
  i: integer;
{  o: TULObj;}
  cp: TULPRObj;
begin
  if FSpec = nil then
    exit;
  if FPeaks = nil then
    exit;
  for i := 0 to FPeaks.Count - 1 do begin
    cp := TULPRObj(FPeaks[i]);
    cp.Response := cp.Response / integer(FPeakAddCounts[i]);
  end;
  FData.FitPeaksInView;
end;

destructor TCompCal.Destroy;
begin
  if FData <> nil then begin
    if FSpec <> nil then begin
      DataCalcFinish;
      FData.SpectrumRelease(FSpec);
      FData.ULF.Save;
    end;
    FData.Free;
  end;
  FPeaks.Free;
  FPeakAddCounts.Free;
  inherited;
end;

procedure TCompCal.PeakAdd(sp: TULPRObj);
var cp: TULPRObj;
begin
  cp := TULPRObj(FSpec.Peaks.Add(ULPRID));
  cp.Assign(sp);
  FPeaks.Add(cp);
  FPeakAddCounts.Add(pointer(1));{tlist}
end;

procedure TCompCal.PeakCalc(cp, sp: TULPRObj);
var i: integer;
begin
  i := FPeaks.IndexOf(cp);
  if i < 0 then
    exit;
  cp.Response := cp.Response + sp.Response;
  FPeakAddCounts[i] := pointer(integer(FPeakAddCounts[i]) + 1);
end;

procedure TCompCal.DataCalc(AAcqData: TAcqData);
var
  i: integer;
  o: TULObj;
  cp, sp: TULPRObj;
begin
  if (FPeaks.Count = 0) and (AAcqData.ULP.ChildCount > 0) then begin
    for i := 0 to AAcqData.ULP.ChildCount - 1 do begin
      o := AAcqData.ULP.Childs[i];
      if o.RecID = ULPRID then
        PeakAdd(TULPRObj(o));
    end;
  end else begin
    for i := 0 to AAcqData.ULP.ChildCount - 1 do begin
      o := AAcqData.ULP.Childs[i];
      if o.RecID = ULPRID then begin
        sp := TULPRObj(o);
        if not FSpec.FindPeakByName(FSpec.Peaks, sp.PeakName, cp) then begin
          PeakAdd(sp);
        end else begin
          PeakCalc(cp, sp);
        end;
      end;
    end;
  end;
end;

end.
