uses Crt;


const
   INT        =  5;
   RECEIVE    =  0;
   TRANSMIT   =  0;
   L_DIVISOR  =  0;
   U_DIVISOR  =  1;
   INT_ENB    =  1;
   INT_ID     =  2;
   LINE_CTRL  =  3;
   MODEM_CTRL =  4;
   LINE_STAT  =  5;
   MODEM_STAT =  6;

var
  dByte : byte;

procedure initCommCard(baseAddr, baudRate : word);
var
  divisor : word;
begin

  {
    Oscillator frequency is 1.8432MHz, or 1,843,200 Hz
    The divisor is calculated by dividing the frequency by 16, then dividing
    again by the baudrate, or --- divisor = (f / 16) / baudrate
    1,843,200 / 16 is 115200, so -
  }
  divisor := 115200 div baudRate;

  { tell card we are about to set options }
  port[baseAddr + LINE_CTRL] := $80;

  { Load the card with the low and high bytes of the divisor. }
  port[baseAddr + L_DIVISOR] := lo(divisor);
  port[baseAddr + U_DIVISOR] := hi(divisor);

  { set the card the 7 bits of data, even parity and 1 stop bit }
  port[baseAddr + LINE_CTRL] := $1A;
  port[baseAddr + MODEM_CTRL] := $00;

  { clear the receive buffer }
  delay(50);
  dByte := port[baseAddr + RECEIVE];
  delay(50);
  dByte := port[baseAddr + RECEIVE];
end;

procedure writePod(baseAddr : word; message : string);
var
  x, times : byte;
begin

  { get length of the string to send }
  x := length(message);

  { set the card into transmit mode }
  port[baseAddr + MODEM_CTRL] := $0F;

  for times := 1 to x do
    begin
      { wait until the card is ready to transmit a character }
      while ((port[baseAddr+LINE_STAT] AND $20) = 0) do;

      { transmit the character }
      port[baseAddr+TRANSMIT] := ord(message[times]);
    end;

  { wait until the character is transmitted }
  while ((port[baseAddr+LINE_STAT] AND $20) = 0) do;

  { transmit a Carriage Return }
  port[baseAddr+TRANSMIT] := $0D;

  { wait until CR is transmitted }
  while ((port[baseAddr+LINE_STAT] AND $20) = 0) do;

  { wait for the card to come back }
  while ((port[baseAddr+LINE_STAT] AND $40) = 0) do;

  { place the card into receive mode }
  port[baseAddr+MODEM_CTRL] := $0D;
end;

procedure readPod(baseAddr : word; var message : string);
var
   x : byte;
   ch : char;
   retstring : string;
   timeout : longint;
begin
  x := 0;
  repeat
     { character location in string is incremented }
     inc(x);

     { timeout initialized }
     timeout := 300000;
     repeat
        { decrement our timeout counter }
        dec(timeout);
        {
          wait until the card sees a character or until our counter has
          timed out.
        }
      until ((timeout = 0) OR ((port[baseAddr+LINE_STAT] AND $01) <> 0));

      { if it has not timed out, store the character }
      if (timeout <> 0) then retstring[x] := chr(port[baseAddr + RECEIVE])
        { otherwise, return with an error message }
        else begin
                message := '??ERROR!';
                exit;
             end;
  { repeat for fifty characters }
  until ((retstring[x] = #$0D) OR (x = 80));
  { Set the string length }
  retstring[0] := chr(x-1);
  { copy it to the parameter }
  message := retstring;

  { and clear the receive buffers }
  delay(50);
  dByte := port[baseAddr + RECEIVE];
  delay(50);
  dByte := port[baseAddr + RECEIVE];
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 }

Var
   Address : word;

procedure printCurrentPointList;
var
   Loop : byte;
   MyStr : String;
begin
   ClrScr;
   WriteLn;
   WriteLn('The current point list configuration for channels 0-7 is : ');
   for Loop := 0 to 7 do begin
      Str(Loop, MyStr);                        { convert to strings }
      WritePod(Address, 'PL0' + MyStr + '?');  { Ask pod }
      ReadPod(Address, MyStr);                 { save response }
      Write('   ', MyStr);
   end;
   WriteLn;
   WriteLn;
end;

procedure changePointList;
var
   Loop : byte;
   MyStr : String;
begin
   WriteLn;
   WriteLn('Changing point list to acquire all even channels, then all odd . . .');
   for Loop := 0 to 3 do begin
      { even }
      MyStr := '';
      { adding 48 turns a number into equivalent ASCII char }
      { place channels in bipolar, -5V to +5V range }
      MyStr := 'PL0'+Chr(Loop + 48)+'=10'+Chr((Loop*2) + 48)+'0';
      WritePod(Address, MyStr);                { tell pod }
      Write(MyStr, ', ');
      ReadPod(Address, MyStr);                 { save response }

      { odd }
      MyStr := '';
      { adding 48 turns a number into equivalent ASCII char }
      { place channels in bipolar, -5V to +5V range }
      MyStr := 'PL0'+Chr(Loop+4+48)+'=10'+Chr((Loop*2)+1+48)+'0';
      WritePod(Address, MyStr);                { tell pod }
      WriteLn(MyStr);
      ReadPod(Address, MyStr);                 { save response }
   end;
   WriteLn;
   WriteLn('Press ENTER to proceed . . .');
   ReadLn;
end;


{calibration routine}

function cal(data:integer):real;
  const
      once:integer=1;
      CALscale:real=0.0;
      CALoffset:integer=0;
  var
    MSG:string;
    tempscale:integer;
    stat:integer;

begin
  if (once=1) then begin
    writePod(Address, 'CAL?');
    readPod(Address,MSG);
    if ( ((MSG[0])=#9) AND (MSG[5]=',') ) then begin {msg is prob. xxxx,xxxx}

      val(copy(MSG,1,4),tempscale,stat);
      val('$'+copy(MSG,6,4),CALoffset,stat);

      if tempscale=0 then CALscale:=1.0 else CALscale:=tempscale / 1000.0;
      once:=0;
    end else begin
      {some error occurred making it impossible to retrieve cal data.}
      {use default data, and inform user.}
      clrscr;
      textcolor(RED);
      writeln('LOAD CALIBRATION DATA FAILED DURING INIT');
      writeln('USING scale=1.0 offset=0');
      writeln('Please Re-run sample to try again.');
      textcolor(LIGHTGRAY);
    end
  end;
  cal:=((data * CALscale) + CALoffset);

end;{end cal}


procedure displayData;
var
   Done : boolean;
   MyStr, tempStr : string;
   Loop, Start : byte;
   Value : Integer;
   ErrorL : integer;
begin
   ClrScr;
   WriteLn('The data being read from the pod is displayed below.');
   WriteLn('Channels are as shown, the pod is actually acquiring');
   WriteLn('the data in this order.');
   WriteLn;
   WriteLn('Press a key to finish the program . . .');
   while (NOT KeyPressed) do begin
      WritePod(Address,'AC00-07,0008');   { convert CH0-CH7, eight total }
      Done := FALSE;
      while (NOT Done) do begin
         WritePod(Address, 'R');          { attempt to read the data }
         ReadPod(Address, MyStr);
         Done := (MyStr <> '') AND (MyStr[1] <> #7); { if error, then conversions not done }
      end;
      for Loop := 0 to 7 do begin          { parse the returned data }
         Start := (Loop * 7) + 3;
         tempStr := Copy(MyStr, Start, 4); { simply copy the 4 bytes we need }
         Val('$'+tempStr,Value,ErrorL);
         GotoXY(15, (Loop * 2) + 7);
         if (Loop <= 3) then
            Write('Channel ',(Loop*2),': ',((10/4096)*cal(Value)):6:3)
         else
            Write('Channel ',(((Loop-4)*2)+1),': ',((10/4096)*cal(Value)):6:3)
      end;
   end;
end;

Var
   Loop : byte;
   MyStr : string;
   ErrorL : integer;
BEGIN
   ClrScr;
   WriteLn('RAD128 Sample Program');
   WriteLn;
   WriteLn('This program will show you how to display and configure the');
   WriteLn('point list to acquire data.  First, the even channels');
   WriteLn('are displayed, then the odds.');
   WriteLn;
   WriteLn('The card must be configured as follows:');
   WriteLn('   RAD128 is set at address 00');
   WriteLn('   Communications is at 9600 bps');
   WriteLn('   Base address of RS485 card is configureable');
   WriteLn;
   WriteLn('Press ENTER to continue . . .');
   ReadLn;
   Address := AskForBaseAddress('300');
   initCommCard(Address, 9600);   { initialize the comm card }
   printCurrentPointList;
   changePointList;
   displayData;

   ClrScr;
   WriteLn('Exiting Sample 1 . . .');
END. { main program }