(*****************************************************************************
 *  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 8255's.   *
 *****************************************************************************)
Program Sample1(input,output);

uses crt;

(* these are the port address offsets for reading and control of the IOD *)
CONST  PortA: word = $300;
       PortB: word = $301;
       PortC: word = $302;
       PortControl: word = $303;

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(15,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. }

BEGIN
   ClrScr;
   WriteLn('              SAMPLE 1.PAS : Read/Write Program');
   WriteLn;
   WriteLn('This sample program demonstrates how to write to and read from a port');
   WriteLn('and how to use the read back function of the 8255 chip.');
   GotoXY(1,6);
   PortA := AskForBaseAddress('350');

   PortB := PortA + 1;
   PortC := PortA + 2;
   PortControl := PortA + 3;
   ClrScr;
   WriteLn;
   WriteLn;
   WriteLn;
   WriteLn('Board Configuration:');
   WriteLn;
   WriteLn(' -- TST/BEN jumper should be in the BEN position   (required)');
   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 *)