(****************************************************************************
 *                     Pascal SAMPLE #1: SAMPLE1.PAS                        *
 *                                                                          *
 * This sample checks for interrupt on FIFO half-full and then reads the    *
 * data out of the FIFO. If you are running the non-FIFO model, the program *
 * polls all channels and displays the data.                                *
 ****************************************************************************)


program sample1;
Uses
   Crt,dos;

Var
OLDISR : procedure;
IRQnumber : integer;
BaseAddress : integer;
irqbase : word;
flag : word;
irqdata : array [0..1023] of word;

procedure sendEOI;
var
   error : integer;
begin
   if (IRQnumber <= 7) then
      port[$20] := $20
   else
      begin
         port[$20] := $20;
         port[$A0] := $20;
      end;
end;



procedure SETCHANNEL(base : word);
var
  i: word;
begin
    portw[base+2] := $0000;
    portw[base+2] := $1010;
    portw[base+2] := $2020;
    portw[base+2] := $3030;
    portw[base+2] := $4040;
    portw[base+2] := $5050;
    portw[base+2] := $6060;
    portw[base+2] := $7070;
    portw[base+2] := $8080;
    portw[base+2] := $9090;
    portw[base+2] := $A0A0;
    portw[base+2] := $B0B0;
    portw[base+2] := $C0C0;
    portw[base+2] := $D0D0;
    portw[base+2] := $E0E0;
    portw[base+2] := $F0F0;
    i:=portw[base+2];
end;

procedure STARTCONVERSION(base : word);
begin
    port[base+0] := 0;{Write anything to base+0 to start conversion}
end;

function RETRIEVEANALOGCONVERSION(base : word) : integer;
var
    data : word;
begin
    data := ((portw[base+0]) and $0fff);{read from base+0 and mask upper nybble}
    RETRIEVEANALOGCONVERSION := data;
end;

function WAITFOREOC(base : word) : boolean;
begin
   WAITFOREOC := ((port[base+4] AND $80) = $80);
end;

procedure CtrMode(addr : word; cntr, mode:byte);
var ctrl:byte;
begin
    ctrl := (cntr shl 6) or $30 or (mode shl 1);
    port[addr+3] := ctrl;
end;

procedure CtrLoad(addr : word; c, val:word);
begin
    port[addr+c] := lo(val);
    port[addr+c] := hi(val);
end;

function CtrRead(addr : word; c : byte) : word;
begin
    port[addr+3] := c shl 6;
    CtrRead := port[addr+c] + (port[addr+c] shl 8);
end;

procedure ENABLECOUNTERS(base: word);
begin
  port[base+4] := $05; {set counter enable bit, starts conversions}
end;

procedure DISABLECOUNTERS(base: word);
begin
    port[base+4] := 0; {stop conversions}
end;

procedure RESETFIFOS(base: word);
var i:integer;
    t:integer;
begin
    port[base+4] := $48;
    for i:=0 to 1023 do
        t:=portw[BASE+0];
    t:=port[BASE+6];
end;

procedure ISR;interrupt;   {interrupt handler}
var
  i:integer;
begin
   if flag > 0 then begin
     flag := 99;
     DISABLECOUNTERS(IRQBASE)
   end else
   begin
     for i:=0 to 1023 do
       irqdata[i]:=portw[IRQBASE+0];
     flag := 1;
   end;
   sendEOI;
end;

function initirq : integer;
var
   intmask : integer;
   oldmask : integer;
   error : integer;

begin
   if (IRQnumber <= 7) then
      begin
         getintvec(IRQnumber + 8, @oldisr);
         setintvec(IRQnumber + 8, addr(ISR));
         oldmask := port[$21];
         intmask := oldmask AND (NOT(1 SHL IRQnumber));
         port[$21] := intmask;
      end
   else
      begin
         getintvec(IRQnumber + $70 - 8, @oldisr);
         setintvec(IRQnumber + $70 - 8, addr(ISR));
         oldmask := port[$A1];
         intmask := oldmask AND (NOT(1 SHL (IRQnumber - 8)));
         port[$A1] := intmask;
      end;
   initirq := oldmask;
end;

procedure resetirq;
var
   intmask : integer;
   error : integer;
begin
   if (IRQnumber <= 7) then
      begin
         intmask := port[$21];
         intmask := intmask OR (1 SHL IRQnumber);
         port[$21] := intmask;
         setintvec(IRQnumber + 8, @oldisr);
      end
   else
      begin
         intmask := port[$A1];
         intmask := intmask OR (1 SHL (IRQnumber - 8));
         port[$A1] := intmask;
         setintvec(IRQnumber + $70 - 8, @oldisr);
      end;
end;

function AskForBaseAddress(OldOne : String) : Word;
const
   Msg : string[4] = '0';
var
   NewOne, Success, Dummy, Error : Word;
   AddrInputPosX, AddrInputPosY : Word;
begin
   if (OldOne = 'OLD') then OldOne := Msg;
   WriteLn('Please enter the Base Address (0000-FFFF) for your card (in hex)');
   WriteLn('or press ENTER for ', OldOne, '.  ');
   Write('>');
   AddrInputPosX := WhereX; AddrInputPosY := WhereY;
   repeat
      GotoXY(AddrInputPosX, AddrInputPosY);
      ClrEol;
      Readln(Msg);
      Val('$' + Msg, NewOne, Error);
      if (Error=0) then begin
         Success := 1;
         Dummy := NewOne;
      end else if (Msg = '') then begin
         GotoXY(AddrInputPosX, AddrInputPosY);
         WriteLn(OldOne);
         Msg := OldOne;
         Success := 1;
         Val('$' + Msg, Dummy, Error);
      end;
   until (Success = 1);
   AskForBaseAddress := Dummy;
end;  { end of AskForBaseAddress }

procedure Fifo(BASE: word);
var
   data: integer;
   x,y: integer;
   a: longint;
   display: real;
begin
   IRQBASE := BASE;
   a:=0;x:=0;y:=0;
   flag:=0;
   clrscr;
   gotoxy(1,4);
   writeln('Press any key to exit.');
   RESETFIFOS(BASE);{clear channel and data fifos}
	SETCHANNEL(BASE); { write channel, range, SE or diff }
   sendEOI;
   initirq;
   sendEOI;
   CtrMode(BASE+8,1,2);
   CtrLoad(BASE+8,1,$150);
   CtrMode(BASE+8,2,2);
   CtrLoad(BASE+8,2,$2);
   ENABLECOUNTERS(BASE); {conversions started once counters are enabled,also sets INT on FIFO half full}
   while(NOT (KeyPressed) AND (flag<>99)) do begin
     if flag <> 0 then begin
       for x:=0 to 1023 do begin
         gotoxy(1,y+8);
         inc(y);
         y := y mod 16;
         data:=irqdata[x] AND $0FFF;
         if data and $800 = $800 then
            data:=data or $F000;{sign extend data}

         display:=data*20.0/4096.0;
         writeln('Channel ',((irqdata[x]) shr 12):2,'   Volts: ',display:6:3,'    Sample number: ',a:6);
         inc(a);
       end; {end for}
       flag := 0;
     end;   {end if}
   end;      {end while}
   if (flag=99) then writeln('ERROR: Acquire Speed too fast!');
   DISABLECOUNTERS(BASE);
   resetirq;
end;

procedure NoFifo(address : word);
var
   data : integer;
   display : real;
   timeout:longint;
   chan:word;
begin
   clrscr;
   gotoxy(1,7);
   writeln('Press any key to exit.');
   DisableCounters(address);

   while (NOT KeyPressed) do begin
      delay(350);
      gotoxy(1,9);
      for chan:=0 to 15 do begin
        timeout := 655354;
        port[address+2] := chan shl 4;
        delay(1);
        STARTCONVERSION(address);
        while (NOT WAITFOREOC(address) AND (timeout > 0)) do dec(timeout);
        if timeout=0 then write('A/D timeout  ') else clreol;

        data := (RETRIEVEANALOGCONVERSION(address)shl 4) div 16;
        display := (data * 20.0) / 4096.0;{ convert to volts=counts * max volt span/max counts }
        writeln('Channel ',chan:2,'  Counts: ', data:4,'   Volts: ',display:5:3);
      end;{end for}
   end;{end while}
end;

const
   baseaddr : string = 'FCA0';
var
   card: char;
   address : word;
begin

   clrscr;
   writeln('PCI-AI12-16(A) Sample 1');
   writeln('--This program will read data from all channels on the A/D card.');
   writeln('--For the FIFO version, the program checks for interrupt on FIFO');
   writeln('--half full and reads the data.');
   writeln('--The non-FIFO version continuously polls all channels.');
   address := AskForBaseAddress(baseaddr);
   writeln('Press "a" for the PCI-AI12-16A or ENTER for the PCI-AI12-16.');
   card:=ReadKey;
   if card = 'a' then begin
     writeln('Enter the IRQ number');
     Readln(IRQNumber);
     Fifo(address)
   end else
     NoFifo(address);
end.