Source file: /~heha/messtech/mio_dde.zip/daqwavi.pas

library daqwavi; {$N+,E-} {MATLAB setzt ohnehin Koprozessor voraus}
{$D Matlab-MEX: Ansteuerung NI-DAQ-Karte (h#s 02/00)}
{Benutzte Funktionen:
 NI_DAQ_MEM_xxx, DAQ_Config, DAQ_Rate, SCAN_Setup, SCAN_Start
}
{$DEFINE GAMEM}
uses pasmex,winprocs,wintypes,win31,wdaq,wutils;

const
 IgnoreBadParams: Boolean=false;
 NoMessage: Boolean=true;
 hintp: THandle=0;		{globales Speicherhandle f�r Waveform}
 warten: Boolean=false;
var
 CatchBuf: TCatchBuf;
 chans: Integer;
 chan,gain: array[0..15] of Integer;
 nsamples: LongInt;

procedure Error(s: PChar);
 begin
  mexVPrintf('DAQWAVI.DLL: FEHLER: %s'#10,s,4);
  Throw(CatchBuf,-1);
 end;

procedure ErrorCode(code: Integer; s: PChar);
 begin
  if code<0 then begin
   mexVPrintf('DAQWAVI.DLL: FEHLER bei %s, Code %d'#10,s,6);
   Throw(CatchBuf,-1);
  end else if code>0 then begin
   mexVPrintf('DAQWAVI.DLL: WARNUNG bei %s, Code %d'#10,s,6);
  end;
 end;

procedure Warning(s: PChar);
 begin
  mexVPrintf('DAQWAVI.DLL: WARNUNG: %s'#10,s,4);
 end;

function GetGain(chan:Integer):Integer;
  far; external 'DAQADC' index 5;

function R2I(pm: PMatrix; min,max: Integer; r: PInteger; hir: Integer):Boolean;
 var
  zp: HPDouble;
 begin
  R2I:=false;
  if not mxIsNumeric(pm) then exit;
  if mxGetN(pm)<>1 then exit;
  zp:=mxGetPr(pm);
  hir:=wutils.min(hir,mxGetM(pm));
  while hir<>0 do begin
   if (zp^<min) or (zp^>max) then exit;
   r^:=Round(zp^);
   Inc(r);
   Inc(zp);
   Dec(hir);
  end;
  R2I:=true;
 end;

procedure FreeHIntP;
 begin
  if hintp<>0 then begin
   DAQ_Clear(1);
{$IFDEF GAMEM}
   GlobalUnlock(hintp);
   GlobalFree(hintp);
{$ELSE}
   NI_DAQ_Mem_Unlock(hintp);
   NI_DAQ_Mem_Free(hintp);
{$ENDIF}
   hintp:=0;
  end;
 end;

function AllocSampleBuffer(nsamples: LongInt; chans: Integer):Integer;
 var
  hip: Integer;
 begin
{$IFDEF GAMEM}
  hip:=GlobalAlloc(GMEM_MoveAble,nsamples*chans*2);
  if hip=0 then ErrorCode(-1,'GlobalAlloc');
{$ELSE}
  ErrorCode(NI_DAQ_Mem_Alloc(hip,2,nsamples*chans,1,1),'NI_DAQ_Mem_Alloc');
{$ENDIF}
  FreeHIntP;
  hintp:=hip;
 end;

procedure MatYield;
 var
  Msg: TMsg;
 begin
  if PeekMessage(Msg,0,0,0,PM_REMOVE) then
  case Msg.message of
   WM_Command: ;			{verschlucken}
   WM_KeyDown: case Msg.wParam of	{verschlucken, aber mit Tasten raus}
    VK_Cancel: Throw(CatchBuf,-2);
    Word('C'): if GetKeyState(VK_Control)<>0 then begin	{^C}
     PostMessage(Msg.hWnd,Msg.message,Msg.wParam,Msg.lParam);
     Throw(CatchBuf,-2);		{^C an Matlab durchreichen}
    end;
   end{case};
   WM_KeyUp: ;				{verschlucken}
   else DispatchMessage(Msg);
  end{case};
 end;

function GetNSamples(pm: PMatrix):LongInt;
 var
  ns: Double;
 begin
  ns:=mxGetScalar(pm);
  if (ns<2) or (ns>4000000) then Error('Sample-Zahl ungültig!');
  GetNSamples:=Round(ns);
 end;

procedure mexFunction(nlhs:Integer; var plhs:TMatArr;
  nrhs:Integer; const prhs:TMatArr); export;
{ const
  tb: array[-1..5] of Single=(5E6,0,1E6,1E5,1E4,1E3,1E2);}
 var
  scale: array[0..15] of Double;
  intp: PInteger;
  rate: Double;
  operation,iterations: Integer;
  vsrec: record
   tb: Integer;		{Zeitbasis}
   si: Word;		{Sample-Intervall}
  end;
  NewestPtIndex: LongInt;
  halfReady: Bool;
  daqStopped: Bool;
  i,j,e: Integer;
  l: LongInt;
  pd: HPDouble;
  s: TS255;
  rmatrix: PMatrix;
 begin
  if Catch(CatchBuf)=0
  then case nrhs of
   3,4: begin		{Kanal, Samplezahl, Rate [,Trigger]}
    asm int 3 end;
    chans:=mxGetN(prhs[0]);
    if chans>16 then begin
     Warning('Kanal-Vektor zu lang - nur 16 Kanäle werden benutzt');
     chans:=16;
    end;
    if not R2I(prhs[0],0,15,@chan[0],chans)
    then Error('Kanalnummer ungültig!');
    for i:=chans-1 downto 1 do for j:=i-1 downto 0 do
    if chan[i]=chan[j] then Error('Kanäle müssen verschieden sein!');

    for i:=chans-1 downto 0 do gain[i]:=GetGain(chan[i]);

    nsamples:=GetNSamples(prhs[1]);

    rate:=mxGetScalar(prhs[2]);
    if rate<0 then begin
     rate:=-rate;
     IgnoreBadParams:=true;
    end;

    DAQ_Config(1,0,0);
    DAQ_DB_Config(1,true);
    e:=DAQ_Rate(rate*chans,false,vsrec.tb,vsrec.si);
    ErrorCode(e,'DAQ_Rate');
    mexVPrintf('TimeBase=%d, SampleInterval=%u'#10,vsrec,sizeof(vsrec));

    AllocSampleBuffer(nsamples,chans);
{$IFDEF GAMEM}
    intp:=GlobalLock(hintp);
{$ELSE}
    NI_DAQ_Mem_Lock(hIntp,Pointer(intp));
{$ENDIF}
    if Chans=1 then begin
     e:=DAQ_Start(1,chan[0],gain[0],intp,nsamples,vsrec.tb,vsrec.si);
    end else begin
     SCAN_Setup(1,chans,@chan[0],@gain[0]);
     e:=SCAN_Start(1,intp,nsamples*chans,vsrec.tb,vsrec.si,1,0);
    end;
    ErrorCode(e,'DAQ_Start bzw. SCAN_Start');

   end;
   1,2: begin
    if not R2I(prhs[0],0,4,@operation,1)
    then Error('falscher Befehlscode');
    if hintp=0 then Error('keine Wellenform geladen');
    case operation of
     0: FreeHIntP;
     1,2: begin
{      nsamples:=1024; if nrhs=2 then nsamples:=GetNSamples(prhs[1]);}
      e:=DAQ_DB_HalfReady(1,halfReady,daqStopped);
      ErrorCode(e,'DAQ_DB_HalfReady');
      if not halfReady then exit;
      intp:=Ptr(GlobalAlloc(GMEM_Fixed,nsamples*chans),0);
      e:=DAQ_DB_Transfer(1,intp,NewestPtIndex,DAQStopped);
      ErrorCode(e,'DAQ_DB_Transfer');
      if nlhs=0 then Warning('Absturzgefahr: Return sollte nicht ANS sein');
      if (nrhs=2)
      and (mxGetM(prhs[1])=chans)
      and (mxGetN(prhs[1])=NewestPtIndex)
      then rmatrix:=prhs[1]
      else begin
       rmatrix:=mxCreateFull(chans,NewestPtIndex,false);
       plhs[0]:=rmatrix;
       Warning('Rueckgabe einer grossen Matrix links!');
      end;
      for i:=chans-1 downto 0 do begin
       AI_VScale(1,chan[i],gain[i],1,0,1,scale[i]);
      end;
      pd:=mxGetPr(rmatrix);
      for l:=NewestPtIndex-1 downto 0 do
      for i:=0 to chans-1 do begin
       pd^:=scale[i]*intp^;
       IncHP(PChar(pd),8);
       Inc(intp);
      end;
      GlobalFree(PtrRec(intp).sel);
     end;
    end{case operation};
   end;

   else mexVPrintf(
    '1 Parameter: 0=stop, 1=getCont, 2=getLast'#10+
{    '2 Parameter: <0> <timeout> in s, -1=unendlich'#10+}
    '3..4 Parameter: <Kanäle> <Block-Länge>'#10+
    ' <Samplerate in Hz> [<Trigger-Bedingung>]'#10+
    'Mehr Info: help daq'#10,chan,0);
  end;
 end;

var
 OldExit: Pointer;

procedure NewExit; far;
{globalen Speicher freigeben}
 begin
  ExitProc:=OldExit;
  FreeHIntP;
 end;

exports
 set_entry_point index 2,
 mexFunction 	 index 3,
 mexAtExitFcn	 index 4;

begin
 OldExit:=ExitProc;
 ExitProc:=@NewExit;
end.
Detected encoding: ANSI (CP1252)4
Wrong umlauts? -
Assume file is OEM (CP437) encoded