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;

type
  calstruct = record
    scale : word;
    offset : word;
  end;
var
  dByte : byte;
  address : word;
  range : word;    {might need to be word}
  span : real;
  calib : array[0..16] of calstruct;

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;

procedure AskForRange;
var
  r : char;
begin
  clrscr;
  writeln('1.  0-5V');
  writeln('2.  0-2.5V');
  writeln('3.  0-1V');
  writeln('4.  0-500mV');
  writeln('5.  0-250mV');
  writeln('6.  0-125mV');
  writeln('7.  0-50mV');
  writeln('8.  0-25mV');
  writeln('');
  writeln('Select the range');
  r := ReadKey;
  case r of
     '1': begin  range := 0; span := 5.0; end;
     '2': begin  range := 1; span := 2.5; end;
     '3': begin  range := 2; span := 1.0; end;
     '4': begin  range := 3; span := 0.5; end;
     '5': begin  range := 4; span := 0.25; end;
     '6': begin  range := 5; span := 0.125;end;
     '7': begin  range := 6; span := 0.05; end;
     '8': begin  range := 7; span := 0.025;end;
  else
    writeln('Not a valid range');
  end;
  clrscr;
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 COM 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 printCurrentPointList;
var
   Loop : byte;
   inst : byte;
   MyStr : String;
begin
   ClrScr;
   WriteLn;
   WriteLn('The current point list configuration for channels 0-15 is : ');
   for Loop := 0 to 15 do begin
      if Loop < 10 then   { skip over ascii chars between 9 and A }
        inst := Loop + 48
      else
        inst := Loop + 55;
      WritePod(Address, 'PL0' + Chr(inst) + '?');  { Ask pod }
      ReadPod(Address, MyStr);                 { save response }
      Write('   ', MyStr);
      if 80 - wherex < 20 then        { keep display clean }
        gotoxy(1,wherey+1);

   end;
   WriteLn;
   WriteLn;
end;


procedure changePointList;
var
   Loop : byte;
   inst : byte;
   MyStr : String;
   TempStr : String;
begin
   WriteLn;
   WriteLn('Setting up point list to acquire data on all channels . . .');
   for Loop := 0 to 15 do begin
      if Loop < 10 then   { skip over ascii chars between 9 and A }
        inst := Loop + 48
      else
        inst := Loop + 55;
      MyStr := '';
      { adding 48 turns a number into equivalent ASCII char }
      MyStr := 'PL0'+Chr(inst)+'='+Chr(range+48)+Chr(inst)+'0000';
      WritePod(Address, MyStr);                { tell pod }
      ReadPod(Address, TempStr);                 { save response }
      Write('  ',TempStr);                          { display onscreen }
   end;
   WriteLn;
   WriteLn('Press ENTER to proceed . . .');
   ReadLn;
end;

function cal(data:integer):real;
begin
  cal:=(((4095.0-calib[range].scale)-calib[range].offset)/4095.0)*data+calib[range].offset;
end;
{calibration routine}


procedure readcal;
var
  MSG:string;
  calstr:string;
  stat:integer;
  i:word;
  inst:word;

begin
 { stat := 4; }
  for i:=0 to 15 do begin
    if i < 10 then   { skip over ascii chars between 9 and A }
      inst := i + 48
    else
      inst := i + 55;
    calstr := 'CAL' + Chr(inst) + '?';  {read current calibration values}
    writePod(Address, calstr);
    readPod(Address,MSG);
    val('$'+copy(MSG,1,4),calib[i].scale,stat);
    val('$'+copy(MSG,6,4),calib[i].offset,stat);
  end;
end; {end cal}


procedure displayData;
var
   Done : boolean;
   MyStr, tempStr : string;
   Loop, Start : byte;
   Value : Integer;
   ErrorL : integer;
   display : real;
begin
   ClrScr;
   WriteLn('The data being read from the pod is displayed below.');
   WriteLn;
   WriteLn('Press a key to finish the program . . .');
   while (NOT KeyPressed) do begin
      WritePod(Address,'AC00-0F,0010');   { convert CH0-CH15, 16 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;
      GotoXY(1,8);
      for Loop := 0 to 15 do begin          { parse the returned data }
         Start := (Loop * 7) + 3;
         tempStr := Copy(MyStr, Start, 4); { copy the 4 bytes we need }
         Val('$'+tempStr,Value,ErrorL);
         display := ((span/4096.0)*cal(Value)); {compute volts for display onscreen}
         Write('Channel ',Loop,': ',display:6:3);
         WriteLn;
      end;
   end;
end;

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

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