unit Ced1401;
{ =================================================================
  WinWCP - CED 1401 Interface Library
  (c) John Dempster, University of Strathclyde, All Rights Reserved
  =================================================================
  V1.0 Started 6/3/97, Working 20/3/97
  V1.1 1/12/97 ... Support for old 1401s without Z8 added
                   using ADCMEMI
  }

interface

uses WinTypes,Dialogs, SysUtils, WinProcs,global, shared, use1401, maths ;

  procedure CED_LoadLibrary  ;
  Procedure CED_GetADCVoltageRangeOptions( var RangeOptions : array of TADCRange ;
                                           var NumOptions : Integer) ;
  procedure  CED_GetSamplingIntervalRange( var MinInterval,MaxInterval : single ) ;
  procedure CED_InitialiseBoard ;
  procedure SendCommand( const CommandString : string ) ;
  procedure CED_ADCToMemory( var ADCBuf : array of integer ;
                             nChannels : LongInt ;
                             nSamples : LongInt ;
                             var dt : Single ;
                             ADCVoltageRange : Single ;
                             WaitForExtTrigger : Boolean ;
                             CircularBuffer : Boolean  ) ;

  procedure CED_GetADCSamples( pADC : Pointer ;
                             var NumSamples : LongInt ) ;
  procedure  CED_StopADC ;
  procedure  CED_MemoryToDAC( var DACBuf : array of integer ;
                              nChannels : LongInt ;
                              nPoints : LongInt ;
                              dt : Single ;
                              NumRepeats : LongInt ;
                              var DACActive : boolean ) ;
  procedure CED_ConvertToDACCodes( var DACBuf : Array of Integer ;
                                  nChannels : LongInt ;
                                  nPoints : LongInt ) ;
  procedure  CED_StopDAC ;

 procedure CED_GetLabInterfaceInfo( var Supplier, Model : String ) ;

 procedure CED_ClockTicks( var dt : single ; var PreScale,Ticks : Word ) ;

  procedure  CED_CheckError( Err : Integer ) ;

  procedure  CED_WriteToDigitalOutPutPort( Pattern : LongInt ) ;
  procedure CED_MemoryToDigitalPort( var DigBuf : array of Integer ;
                                 nValues : LongInt ; dt : single ) ;
  procedure CED_StopDIG ;
  procedure CED_WriteDACs( const DACVolts : array of single ; NumDACS : Integer ) ;
  function  CED_GetMaxDACVolts : single ;
  procedure  CED_GetChannelOffsets( var Offsets : Array of LongInt ; NumChannels : LongInt ) ;
  procedure  CED_ReportFailure( const ProcName : string ) ;
  function  CED_IsLabInterfaceAvailable : boolean ;
  procedure CED_CloseLaboratoryInterface ;
  procedure CED_GetError ;
  function CED_GetType : Integer ;

implementation
const
     ClockPeriod = 1E-6 ; { 1MHz clock }
     MaxDIGTIMSlices = 100 ;
type
    TU14TypeOf1401 = FUNCTION (hand:INTEGER):INTEGER;
    TU14DriverVersion = FUNCTION : LONGINT;
    TU14Open1401 = FUNCTION (n1401:INTEGER):INTEGER;
    TU14Ld = FUNCTION (hand:INTEGER;vl:PChar;str:PChar):DWORD;
    TU14Close1401 = FUNCTION (hand:INTEGER):INTEGER;
    TU14LongsFrom1401 = FUNCTION (hand:INTEGER;palBuff:TpNums;
                                sMaxLongs:INTEGER):INTEGER;
    TU14ToHost = FUNCTION (hand:INTEGER;lpAddrHost:PChar;dwSize:DWORD;
                    lAddr1401:LONGINT;eSz:INTEGER):INTEGER;
    TU14To1401 = FUNCTION (hand:INTEGER;lpAddrHost:PChar;dwSize:DWORD;
                    lAddr1401:LONGINT;eSz:INTEGER):INTEGER;
    TU14sendstring = FUNCTION (hand:INTEGER;PCharing:PChar):INTEGER;
var
   { Variables for dynamic calls to USE1401.DLL }
   U14TypeOf1401 : TU14TypeOf1401 ;
   U14DriverVersion : TU14DriverVersion ;
   U14Open1401 :TU14Open1401 ;
   U14Ld :TU14Ld ;
   U14Close1401 :TU14Close1401 ;
   U14LongsFrom1401 :TU14LongsFrom1401 ;
   U14ToHost : TU14ToHost ;
   U14To1401 : TU14To1401 ;
   U14sendstring : TU14sendstring ;

   LibraryHnd : THandle ; { DLL library handle }

   DeviceNumber : Integer ;     { Lab. interface board in use }
   ADCVoltageRangeMax : single ;  { Max. positive A/D input voltage range}
   DACVoltageRangeMax : single ;
   MaxNativeValue : LongInt ;
   MinSamplingInterval : single ;
   MaxSamplingInterval : single ;
   LibraryLoaded : boolean ;      { True if CED 1401 procedures loaded }
   DeviceInitialised : boolean ; { True if hardware has been initialised }
   Device : Integer ;
   StartOf1401ADCBuffer : DWORD ;
   EndOf1401ADCBuffer : DWORD ;
   StartOf1401Digbuffer : DWORD ;
   EndOf1401Digbuffer : DWORD ;
   StartOf1401DACBuffer : DWORD ;
   EndOf1401DACBuffer : DWORD ;
   ADC1401Pointer : LongInt ;
   CircularBufferMode : boolean ;
   MemoryAvailable : LongInt ;
   TypeOf1401 : Integer ;
   ADCCommand : string ;

procedure CED_LoadLibrary  ;
{ ----------------------------------
  Load USE1401.DLL library into memory
  ----------------------------------}
var

   DLLName0 : array[0..79] of char ;
begin
     { Load library }
     StrPCopy( DLLName0,'USE1401.DLL');
     LibraryHnd := LoadLibrary(DLLName0);

     { Get addresses of procedures in USE1401.DLL }
     if LibraryHnd >= HINSTANCE_ERROR then begin
        @U14TypeOf1401 := GetProcAddress(LibraryHnd,'U14TypeOf1401') ;
        if @U14TypeOf1401 = Nil then CED_ReportFailure('U14TypeOf1401') ;
        @U14DriverVersion := GetProcAddress(LibraryHnd,'U14DriverVersion') ;
        if @U14DriverVersion = Nil then CED_ReportFailure('U14DriverVersion') ;
        @U14Open1401 := GetProcAddress(LibraryHnd,'U14Open1401') ;
        if @U14Open1401 = Nil then CED_ReportFailure('U14Open1401') ;
        @U14Ld := GetProcAddress(LibraryHnd,'U14Ld') ;
        if @U14Ld = Nil then CED_ReportFailure('U14Ld') ;
        @U14Close1401 := GetProcAddress(LibraryHnd,'U14Close1401') ;
        if @U14Close1401 = Nil then CED_ReportFailure('U14Close1401') ;
        @U14LongsFrom1401 := GetProcAddress(LibraryHnd,'U14LongsFrom1401') ;
        if @U14LongsFrom1401 = Nil then CED_ReportFailure('U14LongsFrom1401') ;
        @U14ToHost := GetProcAddress(LibraryHnd,'U14ToHost') ;
        if @U14ToHost = Nil then CED_ReportFailure('U14ToHost') ;
        @U14To1401 := GetProcAddress(LibraryHnd,'U14To1401') ;
        if @U14To1401 = Nil then CED_ReportFailure('U14To1401') ;
        @U14sendstring := GetProcAddress(LibraryHnd,'U14sendstring') ;
        if @U14sendstring = Nil then CED_ReportFailure('U14sendstring') ;
        LibraryLoaded := True ;
        end
     else begin
          MessageDlg( 'USE1401.DLL library not found', mtWarning, [mbOK], 0 ) ;
          LibraryLoaded := False ;
          end ;
     end ;


procedure CED_ReportFailure( const ProcName : string ) ;
begin
     MessageDlg('USE1401.DLL- ' + ProcName + ' not found',mtWarning,[mbOK],0) ;
     end ;


procedure CED_GetLabInterfaceInfo( var Supplier, Model : String ) ;
var
   Ver,VerHigh,VerLow : LongInt ;
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     Supplier := 'Cambridge Electronic Design Ltd.' ;

     if DeviceInitialised then begin

        { Get the 1401 model }
        case U14TypeOf1401( Device ) of
             U14TYPE1401 : Model := 'CED 1401 ';
             U14TYPEPLUS : Model := 'CED 1401-plus ';
             U14TYPEUNKNOWN : Model := 'CED 1401? ';
             else Model := 'CED Micro1401 ' ;
             end ;
        { Add the CED1401.SYS driver version number }
        Ver := U14DriverVersion ;
        VerHigh := Ver div $10000 ;
        VerLow := Ver and $FFFF ;
        Model := Model + format('Driver V%d.%d',[VerHigh,VerLow]) ;

        { Cancel all commands and reset 1401 }
        SendCommand( 'CLEAR;' ) ;

        end
     else begin
          Model := 'Device Not Initialised' ;
          end ;
     end ;


Procedure CED_GetADCVoltageRangeOptions( var RangeOptions : array of TADCRange ;
                                         var NumOptions : Integer) ;
begin
     RangeOptions[0] := ' ±5V ' ;
     NumOptions := 1 ;
     end ;


function  CED_GetMaxDACVolts : single ;
{ -----------------------------------------------------------------
  Return the maximum positive value of the D/A output voltage range
  -----------------------------------------------------------------}
begin
     Result := DACVoltageRangeMax ;
     end ;

procedure  CED_GetSamplingIntervalRange( var MinInterval,MaxInterval : single ) ;
{ ------------------------------------
  Min./max sampling intervals allowed
  ------------------------------------}
begin
     MinInterval := 4E-6 ;
     maxInterval := 1000. ;
     end ;


function  CED_IsLabInterfaceAvailable : boolean ;
begin
     if not DeviceInitialised then CED_InitialiseBoard ;
     Result := DeviceInitialised ;
     end ;


procedure CED_InitialiseBoard ;
{ -------------------------------------------
  Initialise CED 1401 interface hardware
  -------------------------------------------}
var
   RetValue : DWORD ;
   Reply : Array[0..2] of LongInt ;
   NumLongs,Err : Integer ;
begin

   DeviceInitialised := False ;

   { Load CED1401 DLL library }
   if not LibraryLoaded then CED_LoadLibrary ;

   if LibraryLoaded then begin
      { Open 1401 }
      Device := U14Open1401(0) ;
      if Device >= 0 then begin
         { Load ADCMEM command }
         RetValue := U14Ld(Device,' ','ADCMEM') ;
         Err := RetValue and $FFFF ;
         if Err <> U14ERR_NOERROR then begin
              { If ADCMEM load fails (usually due to an old 1401 not
                having a Z8 chip) load the older command ADCMEMI }
              RetValue := U14Ld(Device,' ','ADCMEMI') ;
              Err := RetValue and $FFFF ;
              CED_CheckError(Err) ;
              ADCCommand := 'ADCMEMI' ;
              end
         else ADCCommand := 'ADCMEM' ;

         { Load other commands : MEMDAC = D/A output DIGTIM = digital timing) }
         RetValue := U14Ld(Device,' ','MEMDAC,DIGTIM') ;
         Err := RetValue and $FFFF ;

         if Err = U14ERR_NOERROR then begin
            { CED 1401 model }
            TypeOf1401 := U14TypeOf1401( Device ) ;
            DeviceInitialised := True ;
            { Make all events inputs ACTIVE-LOW }
            SendCommand( 'EVENT,P,63;' ) ;
            end
         else U14Close1401( Device ) ;
         end
      else CED_CheckError(Device) ;

      end ;

   end ;


procedure CED_CheckError( Err : Integer ) ;
{ --------------------------------------------------------------
  Warn User if the Lab. interface library returns an error
  --------------------------------------------------------------}
var
   s : string ;
begin

     if Err <> U14ERR_NOERROR then begin
        case Err of
             -500 : s := 'Present but switched off' ;
             -501 : s := 'Not connected' ;
             -502 : s := 'Not working';
             -503 : s := 'Interface card missing';
             -504 : s := 'Failed to come ready';
             -505 : s := 'Interface card, bad switches';
             -506 : s := '+ failed to come ready';
             -507 : s := 'Could not grab int. vector';
             -508 : s := 'Already in use';
             -509 : s := 'Could not get DMA channel';
             -510 : s := 'Bad handle';
             -511 : s := 'Bad number';
             -520 : s := 'No such function';
             -521 : s := 'No such subfunction';
             -522 : s := 'No room in output buffer';
             -523 : s := 'No input in buffer';
             -524 : s := 'String longer than buffer';
             -525 : s := 'Failed to lock memory';
             -526 : s := 'Failed to unlock memory';
             -527 : s := 'Area already set up';
             -528 : s := 'Area not set up';
             -529 : s := 'Illegal area number';
             -540 : s := 'Command file not found';
             -541 : s := 'Error reading command file';
             -542 : s := 'Unknown command';
             -543 : s := 'Not enough host space to load';
             -544 : s := 'Could not lock resource/command';
             -545 : s := 'CLOAD command failed';
             -560 : s := 'TOHOST/1401 failed';
             -580 : s := 'Not 386 enhanced mode';
             -581 : s := 'No device driver';
             -582 : s := 'Device driver too old';
             -590 : s := 'Timeout occurred';
             -600 : s := 'Buffer for GETSTRING too small';
             -601 : s := 'There is already a callback';
             -602 : s := 'Bad parameter to deregcallback';
             -610 : s := 'Failed talking to driver';
             -611 : s := 'Needed memory and could not get it';
             else s := 'Unknown error' ;
             end ;
        MessageDlg( format('Error CED 1401 %s (%d)',[s,Err]),
                    mtWarning, [mbOK], 0 ) ;
        end ;



     end ;


procedure CED_ADCToMemory( var ADCBuf : array of integer ;
                           nChannels : LongInt ;
                           nSamples : LongInt ;
                           var dt : Single ;
                           ADCVoltageRange : Single ;
                           WaitForExtTrigger : Boolean ;
                           CircularBuffer : Boolean  ) ;
{ -------------------------------
  Set up an A/D conversion sweeep
  -------------------------------}
const
     EmptyFlag = 32767 ;
var
   ch,Err : Integer ;
   dt1 : single ;
   NumBytes,i : LongInt ;
   PreScale,Ticks : Word ;
   CommandString : string ;
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     if DeviceInitialised then begin

        { Kill any A/D conversions in progress }
        SendCommand( ADCCommand + ',K;') ;

        { Make all events inputs ACTIVE-LOW }
        SendCommand( 'EVENT,P,63;' ) ;

        NumBytes := nChannels*nSamples*2 ;

        { Define A/D buffer area within 1401 }
        StartOf1401ADCBuffer := 0 ;
        Endof1401ADCBuffer := NumBytes - 1 ;
        ADC1401Pointer := 0 ;

        { Define digital buffer area }
        StartOf1401DigBuffer := Endof1401ADCBuffer + 1 ;
        EndOf1401DigBuffer := StartOf1401DigBuffer + MaxDIGTIMSlices*16 - 1 ;

        { Define start of D/A buffer area in 1401 }
        StartOf1401DACBuffer := Endof1401DigBuffer + 1 ;

        { ADCMEM command with no.of bytes to be collected }
        if ADCCommand = 'ADCMEM' then
           CommandString := format('%s,I,2,0,%d,',[ADCCommand,NumBytes])
        else
           CommandString := format('%s,2,0,%d,',[ADCCommand,NumBytes]) ;

        { Add channel list }
        for ch := 0 to nChannels-1 do
            CommandString := CommandString + format('%d ',[ch]);

        { Request 1 sweep for single sweep modes, 0 for indefinite repeat }
        if CircularBuffer then begin
           CommandString := CommandString + ',0,' ;
           CircularBufferMode := True ;
           end
        else begin
           CommandString := CommandString + ',1,' ;
           CircularBufferMode := False ;
           end ;

        { Select immediate sweep or wait for ext. trigger pulse }
        if WaitForExtTrigger then CommandString := CommandString + 'CT,'
                             else CommandString := CommandString + 'C,' ;

        { Set sampling clock }
        dt1 := dt / nChannels ;
        CED_ClockTicks( dt1, PreScale, Ticks ) ;
        dt := dt1 * nChannels ;
        CommandString := CommandString + format('%d,%d;',[PreScale,Ticks] );

        { Fill A/D data buffer with empty flag }
        for i := 0 to (nSamples*nChannels)-1 do ADCBuf[i] := EmptyFlag ;

        SendCommand( CommandString ) ;
        CED_GetError ;
        end ;
     end ;

procedure CED_GetADCSamples( pADC : Pointer ;
                             var NumSamples : LongInt ) ;
{ ----------------------------------------------------------
  Transfer new A/D samples in 1401's A/D buffer area to host
  ----------------------------------------------------------}
var
   Reply : Array[0..2] of LongInt ;
   NumLongs,Err : Integer ;
   nBytes,StartAt : LongInt ;
begin

     NumSamples := 0 ;
     SendCommand( ADCCommand + ',P;' ) ;
     NumLongs := U14LongsFrom1401( Device, @Reply, High(Reply) ) ;

     if not CircularBufferMode then begin
        { *** Single sweep mode *** }
        if Reply[0] > ADC1401Pointer then begin
           { Transfer samples to host memory as they are acquired }
           StartAt := ADC1401Pointer ;
           ADC1401Pointer := Reply[0] ;
           nBytes := ADC1401Pointer - StartAt ;
           NumSamples := nBytes div 2 ;
           Err := U14ToHost( Device, pADC, nBytes, StartAt, 0 ) ;
           end
        else if Reply[0] = 0 then begin
           { Special procedure for when A/D sweep is completed }
           { Check to see if A/D sweep has finished }
           SendCommand(ADCCommand + ',?;') ;
           NumLongs := U14LongsFrom1401( Device, @Reply, High(Reply) ) ;
           if Reply[0] = 0 then begin
                nBytes := Endof1401ADCBuffer + 1 - ADC1401Pointer ;
                NumSamples := nBytes div 2 ;
                Err := U14ToHost( Device, pADC, nBytes, ADC1401Pointer, 0 ) ;
                end ;
           end ;
        end
     else begin
          { *** Circular buffer mode *** }
           if Reply[0] > ADC1401Pointer then begin
              { Transfer samples to host memory as they are acquired }
              StartAt := ADC1401Pointer ;
              ADC1401Pointer := Reply[0] ;
              nBytes := ADC1401Pointer - StartAt ;
              NumSamples := nBytes div 2 ;
              Err := U14ToHost( Device, pADC, nBytes, StartAt, 0 ) ;
              end
           else if Reply[0] < ADC1401Pointer then begin
              { Roll-over has occurred ... just transfer the samples
                from the current position until the end of the buffer,
                leave ADC1401Pointer at the start of the buffer }
              StartAt := ADC1401Pointer ;
              nBytes := Endof1401ADCBuffer + 1 - StartAt ;
              NumSamples := nBytes div 2 ;
              Err := U14ToHost( Device, pADC, nBytes, StartAt, 0 ) ;
              ADC1401Pointer := 0 ;
              end ;
           end ;
     end ;


procedure CED_GetError ;
var
   Reply : Array[0..2] of LongInt ;
   NumLongs : Integer ;
begin
     SendCommand( 'ERR;' ) ;
     NumLongs := U14LongsFrom1401( Device, @Reply, High(Reply) ) ;
     end ;


procedure CED_ClockTicks( var dt : single ; var PreScale,Ticks : Word ) ;
var
   fTicks : single ;
begin
     PreScale := 1 ;
     repeat
          Inc(PreScale) ;
          fTicks := dt / (ClockPeriod*PreScale) ;
          until fTicks < 65535. ;
     Ticks := Trunc( fTicks ) ;
     dt := Ticks*PreScale*ClockPeriod ;
     end ;


procedure  CED_StopADC ;
{ -------------------------------------
  Kill any A/D conversions in progress
  -------------------------------------}
var
   Err : Integer ;
begin
     if not DeviceInitialised then CED_InitialiseBoard ;
     if DeviceInitialised then begin
        SendCommand( ADCCommand + ',K;') ;
        { Wait till command done }
        CED_GetError ;
        end ;
     end ;


procedure  CED_MemoryToDAC( var DACBuf : array of integer ;
                              nChannels : LongInt ;
                              nPoints : LongInt ;
                              dt : Single ;
                              NumRepeats : LongInt ;
                              var DACActive : boolean ) ;
{ -------------------------------
   Set up a D/A conversion sweeep
  -------------------------------}
var
   ch : Integer ;
   PreScale,Ticks : Word ;
   CommandString : string ;
   nBytes : DWORD ;
   Reply : Array[0..2] of LongInt ;
   NumLongs : Integer ;
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     if DeviceInitialised then begin
        { Copy data into D/A buffer in 1401 memory }
        nBytes := nPoints*nChannels*2 ;
        Endof1401DACBuffer := StartOf1401DACBuffer + nBytes -1 ;
        U14To1401( Device, @DACBuf, nBytes, StartOf1401DACBuffer, 0 ) ;

        if not DACActive then begin

           { Kill any D/A conversions in progress }
           SendCommand( 'MEMDAC,K;') ;

           if TypeOf1401 = U14TYPE1401 then begin
              { Amount of 1401 memory available }
              SendCommand('MEMTOP;') ;
              NumLongs := U14LongsFrom1401( Device, @Reply, High(Reply) ) ;
              MemoryAvailable := Abs(Trunc( Reply[1] - Reply[0] )) ;
              if Endof1401DACBuffer > MemoryAvailable then
                 MessageDlg( 'ERROR: Not enough 1401 memory', mtWarning, [mbOK], 0 ) ;
              end ;

           { Create MEMDAC command string }
           CommandString := format('MEMDAC,I,2,%d,%d,',[StartOf1401DACBuffer,nBytes]) ;

           { Add channel list }
           for ch := 0 to nChannels-1 do
               CommandString := CommandString + format('%d ',[ch]);

           { Number of repeats (0=continuous repeat) }
           CommandString := CommandString + format(',%d,',[NumRepeats]) ;

           { Set sampling clock and start D/A output }
           CED_ClockTicks( dt, PreScale, Ticks ) ;
           CommandString := CommandString + format('C,%d,%d;',[PreScale,Ticks] );
           SendCommand( CommandString ) ;
           CED_GetError ;
           DACActive := True ;
           end ;
        end ;
     end ;


procedure CED_WriteDACs( const DACVolts : array of single ; NumDACS : Integer ) ;
{ ------------------------
  Write to D/A converters
  -----------------------}
var
   Command : string ;
   DACValue,ch : LongInt ;
   DACScale : single ;
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     if DeviceInitialised then begin
        DACScale := MaxNativeValue / DACVoltageRangeMax ;
        for ch := 0 to MinInt([High(DACVolts),NumDACS-1]) do begin
            DACValue := Trunc( DACVolts[ch]*DACScale ) ;
            Command := format('DAC,%d,%d,2;',[ch,DACValue]);
            SendCommand( Command ) ;
            end ;
        CED_GetError ;
        end ;
     end ;


procedure CED_ConvertToDACCodes( var DACBuf : Array of Integer ;
                                  nChannels : LongInt ;
                                  nPoints : LongInt ) ;
{ ------------------------------------------------
  Convert from +/-2048 ... +/- 32767 for DAC codes
  ------------------------------------------------}
var
   i : LongInt ;
begin

     for i := 0 to (nChannels*nPoints)-1 do DACBuf[i] := DACBuf[i]*16 ;
     end ;


procedure  CED_StopDAC ;
{ -------------------------------------
  Kill any D/A conversions in progress
  -------------------------------------}
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     if DeviceInitialised then begin
        SendCommand( 'MEMDAC,K;') ; { Kill any D/A output }
        SendCommand( 'DIGTIM,K;') ; { Kill any digital output }
        { Wait till command done }
        CED_GetError ;
        end ;

     end ;


procedure  CED_WriteToDigitalOutPutPort( Pattern : LongInt ) ;
{ -------------------------------------------
  Write a value to the digital O/P lines 8-15
  -------------------------------------------}
var
   Command : string ;
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     if DeviceInitialised then begin
        { Stop any digital pattern in progress }
        SendCommand( 'DIGTIM,K;') ;
        { Send digital O/P byte }
        Command := format('DIG,O,%d;',[Pattern*$100 and $FF00]) ;
        SendCommand( Command );
        { Wait till done }
        CED_GetError ;
        end ;
     end ;


procedure CED_MemoryToDigitalPort( var DigBuf : array of Integer ;
                               nValues : LongInt ; dt : single ) ;
{ --------------------------------------------------------
  Set up a digital output sequence within the 1401 memory
  (*NOTE* Event Input 2 (E2) is used to synchronise digital output
  with the start of the record sweeping. Thus the D/A 1 (sync. pulse)
  output is connected to BOTH Event 4 In (Trigger In on Micro1401)
  and Event 2 In (On back panel in Micro1401).)
  -------------------------------------------------------}
type
    TSlice = record
           State : Integer ;
           Count : LongInt ;
           end ;
var
   Slice : Array[0..MaxDIGTIMSlices-1]of TSlice ;
   nSlices : Integer ;
   LastChange,i : LongInt ;
   Command : string ;
   PreScale,Ticks : Word ;
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     if DeviceInitialised then begin

        { Extract bit pattern from digital buffer and convert to
          a series of DIGTIM slices }
        nSlices := 1 ;
        Slice[nSlices-1].State := DigBuf[0] and $FF ;
        Slice[nSlices-1].Count := 2 ;
        { *** BODGE ***
          This second slice put here to sort out a curious bug
          where the time for the second slice is doubled.
          Don't know whether this is a bug in DIGTIM command
          or in my own code. }
        nSlices := 2 ;
        Slice[nSlices-1].State := DigBuf[0] and $FF;
        Slice[nSlices-1].Count := 2 ;

        i := 2 ;
        LastChange := 2 ;
        while (i < nValues) and (nSlices < High(Slice)) do begin;
              Inc(i) ;
              if DigBuf[i] <> DigBuf[i-1] then begin
                 Inc(nSlices) ;
                 Slice[nSlices-1].State := DigBuf[i] and $FF ;
                 Slice[nSlices-1].Count := 2*(i-LastChange) ;
                 LastChange := i ;
                 end ;
              end ;

        Inc(nSlices) ;
        Slice[nSlices-1].State := DigBuf[nValues-1] ;
        Slice[nSlices-1].Count := 2*MaxInt([(nValues-LastChange-1),1]) ;

        { Cancel any DIGTIM commands that are running }
        SendCommand( 'DIGTIM,K;') ;
        CED_GetError ;

        { Make all events inputs ACTIVE-LOW }
        SendCommand( 'EVENT,P,63;' ) ;

        { Create DIGTIM slice table }
        Command := format('DIGTIM,SI,%d,%d;',[StartOf1401DigBuffer,nSlices*16]);
        SendCommand( Command ) ;

        { Allow DIGTIM to control digital O/P ports only }
        SendCommand( 'DIGTIM,OD;' ) ;

        { Send slice table to 1401 }
        for i := 0 to nSlices-1 do begin
            Command := format('DIGTIM,A,$FF,%d,%d;',[Slice[i].State,Slice[i].Count]);
            SendCommand( Command ) ;
            CED_GetError ;
            end ;

        { Set sampling clock and arm DIGTIM digital output
          Note.
          1) clock is run at twice the D/A update rate and slice counts are doubled
          2) DIGTIM clock is gated by Event Input 2 (Active Low) }

        CED_ClockTicks( dt, PreScale, Ticks ) ;
        Ticks := Ticks div 2 ;
        Command := format('DIGTIM,CG,%d,%d,1;',[PreScale,Ticks] );
        SendCommand( Command ) ;
        CED_GetError ;
        end ;

     end ;


procedure CED_StopDIG ;
{ -------------------------------------
  Stop digital output pattern generator
  -------------------------------------}
begin

     if not DeviceInitialised then CED_InitialiseBoard ;
     if DeviceInitialised then begin
        SendCommand( 'DIGTIM,K;' ) ;
        CED_GetError ;
        end ;
     end ;


procedure SendCommand( const CommandString : string ) ;
{ -------------------------------
  Send a command to the CED 1401
  ------------------------------}
var
   Command : string ;
begin

     if not DeviceInitialised then CED_InitialiseBoard ;

     Command := CommandString + chr(0) ;
     CED_CheckError( U14sendstring( Device, @Command[1] ) ) ;
     end ;


procedure  CED_GetChannelOffsets( var Offsets : Array of LongInt ;
                                 NumChannels : LongInt ) ;
{ --------------------------------------------------------
  Returns the order in which analog channels are acquired
  and stored in the A/D data buffers
  --------------------------------------------------------}
var
   ch : Integer ;
begin
     for ch := 0 to NumChannels-1 do Offsets[ch] := ch ;
     end ;

procedure CED_CloseLaboratoryInterface ;
var
   Err : Integer ;
begin

     if DeviceInitialised then begin
        if Device >= 0 then begin
           Err := U14Close1401( Device ) ;
           Device := -1 ;
           DeviceInitialised := False ;
           end ;
        { Remove DLL library from memory }
        if LibraryLoaded then FreeLibrary( LibraryHnd ) ;
        end ;
     end ;

function CED_GetType : Integer ;
begin
     Result := TypeOf1401 ;
     end ;

initialization
    DeviceNumber := -1 ;
    LibraryLoaded := False ;
    DeviceInitialised := False ;
    MinSamplingInterval := 4E-6 ;
    MaxSamplingInterval := 1000. ;
    MaxNativeValue := 32767 ;
    DACVoltageRangeMax := 5. ;
    StartOf1401ADCBuffer := 0 ;
    CircularBufferMode := false ;

end.
