home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / PCL4P30.ZIP / SIMPLE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-01-18  |  4.1 KB  |  128 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*          SIMPLE.PAS      Jan 92           *)
  4. (*                                           *)
  5. (*  SIMPLE is provided as the simpliest      *)
  6. (*  possible terminal program using PCL4P    *)
  7. (*                                           *)
  8. (*  This program is donated to the Public    *)
  9. (*  Domain by MarshallSoft Computing, Inc.   *)
  10. (*  It is provided as an example of the use  *)
  11. (*  of the Personal Communications Library.  *)
  12. (*                                           *)
  13. (*********************************************)
  14.  
  15.  
  16. program simple;
  17. uses crt, PCL4P;
  18.  
  19. const
  20.    BaudCode = Baud2400;  (* Choose baud rate: Baud300 to Baud115200 *)
  21. var
  22.    Buffer  : array[0..1024] of Char;
  23.    RetCode : Integer;
  24.    Byte : Char;
  25.    i    : Integer;
  26.    Port : Integer;
  27.    ResetFlag : Boolean;
  28.  
  29. procedure SayError( Code : Integer );
  30. var
  31.    RetCode : Integer;
  32. begin
  33.    if Code < 0 then RetCode := SioError( Code )
  34.    else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
  35.       begin (* Port Error *)
  36.          if (Code and FramingError) <> 0 then writeln('Framing Error');
  37.          if (Code and ParityError)  <> 0 then writeln('Parity Error');
  38.          if (Code and OverrunError) <> 0 then writeln('Overrun Error')
  39.       end
  40. end;
  41.  
  42. procedure MyHalt( Code : Integer );
  43. var
  44.    RetCode : Integer;
  45. begin
  46.    if Code < 0 then SayError( Code );
  47.    if ResetFlag then RetCode := SioDone(Port);
  48.    writeln('*** HALTING ***');
  49.    Halt;
  50. end;
  51.  
  52. begin   (* main program *)
  53.    ResetFlag := FALSE;
  54.    (* fetch PORT # from command line *)
  55.    if ParamCount <> 1 then
  56.       begin
  57.          writeln('USAGE: "CALLPGM <port>" where port = 1,2,3, or 4');
  58.          halt;
  59.       end;
  60.    Val( ParamStr(1),Port, RetCode );
  61.    if RetCode <> 0 then
  62.       begin
  63.          writeln('Port must be 1 to 4');
  64.          Halt;
  65.       end;
  66.    (* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
  67.    Port := Port - 1;
  68.    if (Port<COM1) or (Port>COM4) then
  69.       begin
  70.          writeln('Port must be 1 to 4');
  71.          Halt
  72.       end;
  73.    (* setup 1K receive buffer *)
  74.    RetCode := SioRxBuf(Port, Ofs(Buffer), Seg(Buffer), Size1024);
  75.    if RetCode < 0 then MyHalt( RetCode );
  76.    (* reset port *)
  77.    RetCode := SioReset(Port,BaudCode);
  78.    (* if error then try one more time *)
  79.    if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  80.    (* Was port reset ? *)
  81.    if RetCode <> 0 then
  82.      begin
  83.         writeln('Cannot reset COM',Port+1);
  84.         MyHalt( RetCode );
  85.      end;
  86.    (* Port successfully reset *)
  87.    writeln('Reset successfull');
  88.    ResetFlag := TRUE;
  89.    (* specify parity, # stop bits, and word length for port *)
  90.    RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  91.    if RetCode < 0 then MyHalt( RetCode );
  92.    writeln; writeln(' CALLPGM 1.0: COM',1+Port,': 2400 Baud: Type ESC to quit');
  93.    RetCode := SioRxFlush(Port);
  94.    if RetCode < 0 then MyHalt( RetCode );
  95.    (* begin terminal loop *)
  96.    writeln('Enter terminal loop');
  97.    while TRUE do
  98.       begin
  99.          (* did user press Ctrl-BREAK ? *)
  100.          if SioBrkKey then
  101.             begin
  102.                writeln('User typed Ctl-BREAK');
  103.                RetCode := SioDone(Port);
  104.                Halt;
  105.             end;
  106.          (* anything incoming over serial port ? *)
  107.          RetCode := SioGetc(Port,0);
  108.          if RetCode < -1 then MyHalt( RetCode );
  109.          if RetCode > -1 then Write( chr(RetCode) );
  110.          (* has user pressed keyboard ? *)
  111.          if KeyPressed then
  112.             begin
  113.                (* read keyboard *)
  114.                Byte := ReadKey;
  115.                (* quit if user types ESC *)
  116.                if Byte = chr($1b) then
  117.                   begin
  118.                      writeln('User typed ESC');
  119.                      RetCode := SioDone(Port);
  120.                      Halt;
  121.                   end;
  122.                (* send out over serial line *)
  123.                RetCode := SioPutc(Port, Byte );
  124.                if RetCode < 0 then MyHalt( RetCode );
  125.             end
  126.       end
  127. end.
  128.