(*****************************************************************************
 *  This sample program will sequentially turn on all bits of the relay input*
 *  and sequentially turn them off.  Each time it sets a new bit, both the    *
 *  relay output and the opto input are read and the data displayed.  This   *
 *  demonstrates how to read and write to a port, and to use the read back   *
 *  function of the board.                                                   *
 *****************************************************************************)
program sample1(input,output);

uses crt;

(* these are the port address offsets for reading and control of the IRRO-8 *)

TYPE   port_array = array[0..3] of byte;
Var    Address : word;

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 }


(*****************************************************************************
 *  FUNCTION: signon -- local routine                                        *
 *  PURPOSE: To display an initial sign on message on the screen.           *
 *****************************************************************************)
procedure signon;

begin
clrscr;
gotoxy(4,1);
writeln('           I I R O - 8  C A R D  S A M P L E  P R O G R A M ');
writeln;
writeln('This sample program will sequentially turn on all bits of the relay input');
writeln('and sequentially turn them off.  Each time it sets a new bit, both the');
writeln('relay output and the opto input are read and the data displayed.  This');
writeln('demonstrates how to read and write to a port, and to use the read back');
writeln('function of the board.');
writeln;
writeln;
   Address:=AskForBaseAddress('354');
clrscr;
writeln;
writeln;
writeln;
writeln('Board Configuration:');
writeln;
writeln(' -- The IRQ5 jumper should be installed     (required)');
writeln(' -- All remaining jumper settings are irrelevant.');
writeln;
writeln;
writeln;
writeln('Press any key to continue');
readln;
clrscr;
gotoxy(12,6);
writeln(' RELAY  OUTPUT    RELAY READBACK      OPTO INPUT ');
gotoxy(12,7);
writeln(' -------------    --------------      ---------- ');
gotoxy(20,15);
writeln(' PRESS ANY KEY TO EXIT PROGRAM ');
end; (* signon *)

(*****************************************************************************
 *  FUNCTION: write_port_data -- local routine                               *
 *  PURPOSE: Displays the current port values on the screen.                *
 *****************************************************************************)
procedure write_port_data(current:port_array);

var x,y,index1,index         :word;
    value                    :byte;

begin
x := 15;          (* starting x coordinate to write data to screen *)
y := 8;           (* constant y coordinate to write data to screen *)
for index := 0 to 2 do (* for each array member *)
   begin
   value := current[index];
   for index1 := 0 to 7 do  (* for each bit in array member *)
      begin
      gotoxy(x,y);
      if (value mod 2) <> 0 then write('1') else write('0');
      value := value div 2;                (* roll next display bit *)
      x:=x+1;
      end;
   x:=x+10;
   end;
end;  (* write_port_data *)

(*****************************************************************************
 *  FUNCTION: main -- external routine                                       *
 *****************************************************************************)
var current         :port_array;
    shift_left      :boolean;

begin
signon;                          (* print the start up message         *)
current[0] := 0;
shift_left := TRUE;
while not keypressed do          (* loop until key pressed             *)
   begin
   port[Address] := current[0]; (* write value to relays              *)
   delay(10);
   current[1] := port[Address]; (* read back what we wrote to relays  *)
   current[2] := port[Address+1];   (* read the data on opto inputs       *)
   write_port_data(current);     (* write new data to screen           *)
   delay(700);

   (* compute value to turn on/off next bit in line *)
   if current[0] = 0 then shift_left := TRUE;
   if current[0] = 255 then shift_left := FALSE;
   if shift_left then current[0] := current[0] * 2 + 1
   else current[0] := (current[0] - 1) div 2;
   end;
clrscr;
end. (* main program *)