(*****************************************************************************
 *  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 *)
VAR    PortA : word;
       PortB : word;
       PortC : word;
       PortControl : word;

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

VAR
 A: Char;


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;
writeln('                     SAMPLE 1.PAS : IOD48S');
writeln;
writeln('This demonstrates how to read and write to a port, and how to use the');
writeln('read back function of the 8255 chip.');
writeln;
writeln;
PortA:=AskForBaseAddress('300');
clrscr;
gotoxy(1,4);
writeln('Board Configuration:');
writeln;
writeln(' -- The IRQ5 jumper should be installed              (required)');
writeln(' -- The TST/BEN jumper should be in the BEN position (required)');
writeln(' -- All remaining jumper settings are irrelevant.');
gotoxy(1,10);
writeln('Press a key to continue.');
A:=readKey;
clrscr;
gotoxy(12,1);
writeln('     I O D  C A R D  S A M P L E  P R O G R A M ');
gotoxy(10,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: main -- external routine                                       *
 *****************************************************************************)
var current         :port_array;
    shift_left      :boolean;
    ch              :char; { Temporary variable to strip the keypress from the
                            buffer. }
begin
signon;                          (* print the start up message         *)
PortB:=PortA+1;
PortC:=PortA+2;
PortControl:=PortA+3;
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 *)