{---------------------------------------------------------------------------
The control program for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 2001

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Программа управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 2001

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
unit MCAD_MiscFuncs;

interface
  uses
    Windows,
    c_MI1201, MITypes,
    McadUserTypes, McadUserEx, MCAD_MI1201_Types, MCAD_MI1201_Errors;

// Размещение массива средствами Delphi
procedure ArrayDeallocate(var a:COMPLEXARRAY);
function  ArrayAllocate(var a:COMPLEXARRAY; rows,cols:uint;
                         AllocateReal,AllocateImag:boolean):boolean;

procedure ArrayClear(var a:COMPLEXARRAY);
function  ArrayCopy(const Source:COMPLEXARRAY; var Dest:COMPLEXARRAY):boolean;
function  ArrayCopyColumn(SrcCol:uint; const Source:COMPLEXARRAY; DstCol:uint; var Dest:COMPLEXARRAY):boolean;
// END - Размещение массива средствами Delphi

// Размещение массива средствами MathCAD
function xMathcadArrayAllocate(var Complex_Array:COMPLEXARRAY;
                               rows:uint;
                               cols:uint;
                               allocateReal:boolean;
                               allocateImag:boolean):tErrorCode;
// Преобразование номер клапана <-> клапан
function ValveNum2Source(n:INTEGER):tSource;
function Source2ValveNum(s:tSource):INTEGER;

// Преобразование номер мотора <-> устройство
function Parameter2Device(p:tParameter):tDevice;
function Device2Parameter(d:tDevice):tParameter;

procedure ArrayFillPoint(var ca:ComplexArray; Src,Dst:uint);
procedure ArraysCopyPoint(const SrcCa:ComplexArray; var DstCa:ComplexArray; Src,Dst:uint);
procedure ColumnClear(var C:tColumn; rows:uint);

implementation
  uses
    MCAD_MI1201_Thread0;


function Parameter2Device;
begin
  case p of
    pIonizationVoltage: Result:=IonizationVoltage;
    pEmissionCurrent:   Result:=EmissionCurrent;
    pExtractingVoltage: Result:=ExtractingVoltage;
    pFocusingVoltage:   Result:=FocusingVoltage;
    pCorrectionX:       Result:=CorrectionX;
    pCorrectionZ:       Result:=CorrectionZ;
    pSEM_Voltage:       Result:=SEM_Voltage;
    else                Result:=UnknownDevice;
  end;
end;

function Device2Parameter;
begin
  case d of
    IonizationVoltage:  Result:=pIonizationVoltage;
    EmissionCurrent:    Result:=pEmissionCurrent;
    ExtractingVoltage:  Result:=pExtractingVoltage;
    FocusingVoltage:    Result:=pFocusingVoltage;
    CorrectionX:        Result:=pCorrectionX;
    CorrectionZ:        Result:=pCorrectionZ;
    SEM_Voltage:        Result:=pSEM_Voltage;
    else                Result:=pNone;
  end;
end;

function ValveNum2Source;
begin
  case n of
   -1:Result:=sBad;
    3:Result:=sSample1;
    4:Result:=sStandard1;
    5:Result:=sStandard2;
    6:Result:=sPumping;
    7:Result:=sStandard3;
    8:Result:=sStandard4;
    9:Result:=sSample2;
    else Result:=sCloseAll;
  end;
end;

function Source2ValveNum;
begin
  case s of
    sBad:             Result:=-1;
    sSample1:         Result:=3;
    sStandard1:       Result:=4;
    sStandard2:       Result:=5;
    sPumping:         Result:=6;
    sStandard3:       Result:=7;
    sStandard4:       Result:=8;
    sSample2:         Result:=9;
    sCloseAll:        Result:=0;
    else              Result:=$FFFF;
  end;
end;

procedure ArrayCopyPoint(var ca:ComplexArray; Src,Dst:uint);
  var i:uint;
begin
  for i:=0 to Pred(ca.cols) do begin
    ca.hReal[i,Dst]:=ca.hReal[i,Src];
  end;
end;

procedure ArrayFillPoint(var ca:ComplexArray; Src,Dst:uint);
begin
  if (Src>=ca.rows) or (Dst>=ca.rows) or (cFullIntegrationTime>=ca.rows) or (Src=Dst) then Exit;
  if ca.hReal[cFullIntegrationTime,Dst]=0 then begin
    ArrayCopyPoint(ca,Src,Dst)
  end;
end;

procedure ArraysCopyPoint(const SrcCa:ComplexArray; var DstCa:ComplexArray; Src,Dst:uint);
  var i:uint;
begin
  if (Src>=SrcCa.rows) or (Dst>=DstCa.rows) or (SrcCa.cols<>DstCa.cols) then Exit;
  for i:=0 to Pred(SrcCa.cols) do begin
    DstCa.hReal[i,Dst]:=SrcCa.hReal[i,Src];
  end;
end;

function xMathcadArrayAllocate;
begin
  if not MathcadArrayAllocate(Complex_Array,rows,cols,allocateReal,allocateImag) then
     Result:=ecINSUFFICIENT_MEMORY
  else
     Result:=MCAD_MI1201_Errors.ecOK;
end;

function SizeOfColumn(rows:cardinal):cardinal;
begin
  Result:=rows*SizeOf(double);
end;

procedure MatrixCopy(const Source:tMatrix; var Dest:tMatrix; rows,cols:uint);
  var i:uint; sz:cardinal;
begin
  sz:=SizeOfColumn(rows);
  for i:=0 to Pred(cols) do begin
    Move(Source[i]^,Dest[i]^,sz);
  end;
end;

function ArrayCopy;
begin
  Result:=false;
  if (Source.rows<>Dest.Rows) or (Source.cols<>Dest.cols) then exit;
  if Assigned(Source.hReal) and Assigned(Dest.hReal) then begin
    MatrixCopy(Source.hReal^,Dest.hReal^,Source.rows,Source.cols);
    Result:=TRUE;
  end;
  if Assigned(Source.hImag) and Assigned(Dest.hImag) then begin
    MatrixCopy(Source.hImag^,Dest.hImag^,Source.rows,Source.cols);
    Result:=TRUE;
  end;
end;

function ArrayCopyColumn;
  var sz:uint;
begin
  Result:=false;
  if (Source.rows<>Dest.Rows) or (SrcCol>=Source.cols) or (DstCol>=Dest.cols) then exit;
  sz:=SizeOfColumn(Source.rows);
  if Assigned(Source.hReal) and Assigned(Dest.hReal) then begin
    Move(Source.hReal^[SrcCol]^,Dest.hReal^[DstCol]^,sz);
    Result:=TRUE;
  end;
  if Assigned(Source.hImag) and Assigned(Dest.hImag) then begin
    Move(Source.hImag^[SrcCol]^,Dest.hImag^[DstCol]^,sz);
    Result:=TRUE;
  end;
end;

procedure ColumnClear(var C:tColumn; rows:uint);
  var i:ulong;
begin
  for i:=0 to Pred(rows) do begin
    C[i]:=0;
  end;
end;

procedure MatrixClear(var M:tMatrix; rows,cols:uint);
  var i:ulong; sz:ulong;
begin
  ColumnClear(M[0]^, rows);
{  for i:=0 to Pred(rows) do begin
    M[0,i]:=0;
  end;}
  sz:=SizeOfColumn(rows);
  for i:=1 to Pred(cols) do begin
    Move(M[0]^,M[i]^,sz);
  end;
end;

procedure ArrayClear;
begin
  if Assigned(a.hReal) then
     MatrixClear(a.hReal^,a.rows,a.cols);
  if Assigned(a.hImag) then
     MatrixClear(a.hImag^,a.rows,a.cols);
end;

procedure MaxrixDeallocate(var m:tPtrToMatrix; rows,cols:cardinal);
  var i:cardinal; sz:ulong;
begin
  if not Assigned(m) then exit;
  if cols=0 then Exit;
  sz:=SizeOfColumn(rows);
  for i:=0 to Pred(cols) do begin
    if Assigned(m[i]) then begin
      FreeMem(m^[i],sz);
    end;
  end;
  FreeMem(m,cols*SizeOf(m^[0]));
  m:=NIL;
end;

procedure MaxrixAllocate(var m:tPtrToMatrix; rows,cols:cardinal);
  var i,j:ulong; sz:ulong;
begin
  m:=NIL;
  if (rows=0) or (cols=0) then exit;
  try
    GetMem(m,cols*SizeOf(m^[0]));
  except
    m:=NIL;
  end;
  if Assigned(m) then begin
    sz:=SizeOfColumn(rows);
    for i:=0 to Pred(cols) do begin
      try
       GetMem(m^[i],sz);
      except
        for j:=i to Pred(cols) do begin
          m^[j]:=NIL;
        end;
        MaxrixDeallocate(m,i,rows);
        break;
      end;
    end;
  end;
end;

procedure ArrayDeallocate;
begin
  MaxrixDeallocate(a.hReal, a.rows, a.cols);
  MaxrixDeallocate(a.hImag, a.rows, a.cols);
  a.cols:=0;
  a.rows:=0;
end;

function ArrayAllocate;
begin
  ArrayDeallocate(a);
  Result:=FALSE;

  if (rows=0) or (cols=0) then Exit;

  if AllocateReal then begin
    MaxrixAllocate(a.hReal,rows,cols);
    if not Assigned(a.hReal) then Exit;
  end;
  if AllocateImag then begin
    MaxrixAllocate(a.hImag,rows,cols);
    if not Assigned(a.hImag) then ArrayDeallocate(a);
  end;
  Result:=Assigned(a.hImag) or Assigned(a.hReal);
  if Result then begin
    a.Rows:=rows;
    a.Cols:=cols;
  end;
end;

end.