(*****************************************************************************
 *  This sample program will sequentially turn on all bits in port A and then*
 *  sequentially turn them off.  Each time it sets a new bit, both port A and*
 *  port B 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 8255 chip. *
 *  If the port A pins are jumpered to the port B pins, then a board test    *
 *  program results, with port B being used to verify what has been written  *
 *  to port A.  The program will use port 0 of cards with multiple 8255s.    *
 *****************************************************************************)
program sample1(input,output);

uses crt;

(* these are the port address offsets for reading and control of the IOD *)

TYPE   port_array = array[0..3] of byte;

VAR
 A: Char;

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

begin
   ClrScr;
   GotoXY(21,1);
   WriteLn('I O D  C A R D  S A M P L E  P R O G R A M ');
   GotoXY(15,4);
   WriteLn('Connect a loopback cable from PORT A to PORT B of PPI0.');
   GotoXY(27,12);
   WriteLn(' PRESS ANY KEY TO CONTINUE. ');
   A := readKey;
   GotoXY(17,8);
   WriteLn(' PORT A OUTPUT     PORT A INPUT      PORT B INPUT ');
   GotoXY(17,9);
   WriteLn(' -------------     ------------      ------------ ');
   GotoXY(27,12);
   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 := 20;          (* starting x coordinate to write data to screen *)
y := 10;           (* 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: AskForBaseAddress                                          *
 *      PURPOSE: Allows the user to input the base address                   *
 *****************************************************************************)
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: main -- external routine*)
var current         :port_array;
    shift_left      :boolean;
    ch              :char; { Temporary variable to strip the keypress from the
                             buffer }
    PortA           :word;
    PortB           :word;
    PortC           :word;
    PortControl     :word;

begin

   ClrScr;
   WriteLn('                    SAMPLE 1.PAS : READ/WRITE');
   WriteLn;
   WriteLn('This sample program will sequentially turn on all bits in port A and then');
   WriteLn('sequentially turn them off.  Each time it sets a new bit, both port A and');
   WriteLn('port B are read and the data displayed.  This demonstrates how to read');
   WriteLn('and write to a port, and to use the read back function of the 8255 chip.');
   WriteLn('If the port A pins are jumpered to the port B pins, then a board test');
   WriteLn('program results, with port B being used to verify what has been written');
   WriteLn('to port A.  The program will use port 0 of cards with multiple 8255s.');

   GotoXY(1,11);
   PortA := AskForBaseAddress('2A0');

   PortB := PortA + 1;
   PortC := PortA + 2;
   PortControl := PortA + 3;
   ClrScr;
   GotoXY(1,4);
   WriteLn('Board Configuration:');
   WriteLn;
   WriteLn(' -- All remaining jumper settings are irrelevant.');
   WriteLn;
   WriteLn;
   WriteLn('Press a key to continue');
   ch := readkey;
   ClrScr;

   signon;                          (* print the start up message         *)
   port[PortControl] := $8b;        (* send the control byte              *)
   current[0] := 0;
   shift_left := TRUE;
   while not keypressed do          (* loop until key pressed             *)
      begin
      port[PortA] := current[0];    (* write value to port a              *)
      delay(10);
      current[1] := port[PortA];    (* read back what we wrote to port A  *)
      current[2] := port[PortB];    (* read the data on port B            *)
      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;
   ch := readkey; { Catch the trailing keypress. }
   ClrScr;
end. (* main program *)