home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PCL10.ZIP / CALLPGM.PAS next >
Encoding:
Pascal/Delphi Source File  |  1991-05-30  |  3.5 KB  |  115 lines
  1. (*************************************)
  2. (*                                   *)
  3. (*         CALLPGM.PAS 1.0           *)
  4. (*                                   *)
  5. (*   Simple terminal emulator to     *)
  6. (*      test the PCL functions       *)
  7. (*                                   *)
  8. (*************************************)
  9.  
  10. program term;
  11. uses PCL;
  12.  
  13. const
  14.    BaudCode = Baud38400;  (* Choose baud rate: Baud300 to Baud115200 *)
  15. var
  16.    Buffer  : array[0..1024] of Char;
  17.    RetCode : Integer;
  18.    Byte : Char;
  19.    i    : Integer;
  20.    Port : Integer;
  21.    ResetFlag : Boolean;
  22.  
  23. procedure SayError( Code : Integer );
  24. var
  25.    RetCode : Integer;
  26. begin
  27.    if Code < 0 then RetCode := SioError( Code )
  28.    else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
  29.       begin (* Port Error *)
  30.          if (Code and FramingError) <> 0 then writeln('Framing Error');
  31.          if (Code and ParityError)  <> 0 then writeln('Parity Error');
  32.          if (Code and OverrunError) <> 0 then writeln('Overrun Error')
  33.       end
  34. end;
  35.  
  36. procedure MyHalt( Code : Integer );
  37. var
  38.    RetCode : Integer;
  39. begin
  40.    SayError( Code );
  41.    if ResetFlag then RetCode := SioDone(Port);
  42.    Halt;
  43. end;
  44.  
  45. begin   (* main program *)
  46.    ResetFlag := FALSE;
  47.    (* fetch PORT # from command line *)
  48.    if ParamCount <> 1 then
  49.       begin
  50.          writeln('USAGE: "CALLPGM <port>" where port = 1,2,3, or 4');
  51.          halt;
  52.       end;
  53.    Val( ParamStr(1),Port, RetCode );
  54.    if RetCode <> 0 then
  55.       begin
  56.          writeln('Port must be 1 to 4');
  57.          Halt;
  58.       end;
  59.    (* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
  60.    Port := Port - 1;
  61.    if (Port<COM1) or (Port>COM4) then
  62.       begin
  63.          writeln('Port must be 1 to 4');
  64.          Halt
  65.       end;
  66.    (* setup receive 1K receive buffer *)
  67.    RetCode := SioRxBuf(Port, Ofs(Buffer), Seg(Buffer), Size1024);
  68.    if RetCode < 0 then MyHalt( RetCode );
  69.    (* attempt to reset port *)
  70.    i := 0;
  71.    repeat
  72.       i := i + 1;
  73.       RetCode := SioReset(Port,BaudCode);
  74.       if RetCode <> 0 then SayError(RetCode);
  75.    until (RetCode = 0) or (i > 5);
  76.    (* Was port reset ? *)
  77.    if RetCode <> 0 then
  78.      begin
  79.         writeln('Cannot reset COM',Port+1);
  80.         MyHalt( RetCode );
  81.      end;
  82.    (* Port successfully reset *)
  83.    ResetFlag := TRUE;
  84.    (* specify parity, # stop bits, and word length for port *)
  85.    RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  86.    if RetCode < 0 then MyHalt( RetCode );
  87.    writeln; writeln(' CALLPGM 1.0: COM',1+Port,': 38400 Baud: Type ESC to quit');
  88.    RetCode := SioRxFlush(Port);
  89.    if RetCode < 0 then MyHalt( RetCode );
  90.    (* begin terminal loop *)
  91.    while TRUE do
  92.       begin
  93.          (* anything incoming over serial port ? *)
  94.          RetCode := SioGetc(Port,0);
  95.          if RetCode < -1 then MyHalt( RetCode );
  96.          if RetCode > -1 then RetCode := SioCrtWrite( chr(RetCode) );
  97.          (* has user pressed keyboard ? *)
  98.          if SioKeyPress then
  99.             begin
  100.                (* read keyboard *)
  101.                Byte := SioKeyRead;
  102.                (* quit if user types ESC *)
  103.                if Byte = chr($1b) then
  104.                   begin
  105.                      writeln('User typed ESC');
  106.                      RetCode := SioDone(Port);
  107.                      Halt;
  108.                   end;
  109.                (* send out over serial line *)
  110.                RetCode := SioPutc(Port, Byte );
  111.                if RetCode < 0 then MyHalt( RetCode );
  112.             end
  113.       end
  114. end.
  115.