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: OEM (CP437) | 1
|
|
|