(* TERM_IO.PAS *)

{  $DEFINE DEBUG}
{$I DEFINES.PAS}

(*********************************************)
(*                                           *)
(*  Used for I/O by TERM.PAS                 *)
(*                                           *)
(*  This program is donated to the Public    *)
(*  Domain by MarshallSoft Computing, Inc.   *)
(*  It is provided as an example of the use  *)
(*  of the Personal Communications Library.  *)
(*                                           *)
(*********************************************)


unit term_IO;

interface

type
  String40 = String[40];
  String20 = String[20];

Procedure WriteMsg(MsgString:String40; StartCol:Byte);
Procedure ReadMsg(VAR MsgString:String20; StartCol, MaxLength:Byte);
Procedure PutChar(Port:Integer; c:Byte);
Function  GetChar(Port:Integer; Timeout:Integer):Integer;
Procedure SayError(Code:Integer;Message:String40);
Procedure TxCAN(Port:Integer);

implementation

uses PCL4P,HEX_IO,CRT;

const
  CR  : Byte = $0d;
  ESC : Byte = $1B;
  BS  : Byte = $08;
  BLK : Byte = $20;
  CAN : Byte = $18;


Procedure WriteMsg(MsgString:String40; StartCol:Byte);
var
  i:Integer;
  Row:Byte;
  Col:Byte;
begin
  Col := WhereX;
  Row := WhereY;
  (* goto display window *)
  Window(1,25,80,25);
  HighVideo;
  GotoXY(StartCol,1);
  Write(MsgString);
  for i := Length(MsgString)+1 to 39 do Write(' ');
  (* back to main window *)
  Window(1,1,80,24);
  LowVideo;
  GotoXY(Col,Row);
end;


Procedure ReadMsg(VAR MsgString:String20; StartCol, MaxLength:Byte);
Label 999;
var
  Row:Byte;
  Col:Byte;
  i  :Byte;
  c  :Char;
begin
  Row := WhereY;
  Col := WhereX;
  (* goto  display window *)
  Window(1,25,80,25);
  HighVideo;
  (* input text from user *)
  i := 0;
  while true do
     begin
       GotoXY(StartCol+i,1);
       c := ReadKey;
       case ord(c) of
         $0D : goto 999;
         $1B : (* Escape *)
           begin
             (* return empty string *)
             i := 0;
             goto 999;
           end;
         $08 : (* backspace *)
           begin
             (* back up if can *)
             if i > 0 then
               begin
                 (* adjust buffer *)
                 i := i - 1;
                 (* write blank at cursor *)
                 GotoXY(StartCol+i,1);
                 write(' ');
                 GotoXY(StartCol+i,1)
               end
           end
       else (* not one of above special chars *)
         begin
           (* save character *)
           i := i + 1;
           MsgString[i] := c;
           (* display on bottom line *)
           Write(c);
           (* done ? *)
           if i = MaxLength then goto 999;
         end
       end (* case *)
     end; (* end while *)
999:(* set length *)
  MsgString[0] := chr(i);
  (* back to main window *)
  Window(1,1,80,24);
  LowVideo;
  GotoXY(Col,Row);
end;

(*** Send character over serial line ***)

Procedure PutChar(Port:Integer; C:Byte);
var
  Code:Integer;
begin
  Code := SioPutc(Port,chr(C));
  if Code < 0 then
     begin
       writeln('COM',1+Port,' error');
       Code := SioError(Code);
       Code := SioDone(Port);
       Halt;
     end;
{$IFDEF DEBUG}
  if (C < $20) or (C > $7E) then
    begin
      write('[$');
      WriteHexByte(C);
      write(']');
    end
  else write( chr(C) );
{$ENDIF}
end;

(*** Receive character from serial line ***)

Function GetChar(Port:Integer; Timeout:Integer):Integer;
var
  Code:Integer;
begin
  Code := SioGetc(Port,Timeout);
  if Code < -1 then
    begin
      writeln('COM',1+Port,' error');
      Code := SioError(Code);
      Halt;
    end;
{$IFDEF DEBUG}
  if (Code < $20) or (Code > $7E) then
    begin
      write('($');
      WriteHexByte(Code);
      write(')');
    end
  else write( chr(Code) );
{$ENDIF}
  GetChar := Code;
end;

(*** Say error code ***)

procedure SayError(Code:Integer;Message:String40);
var
   RetCode:Integer;
begin
   writeln(Message);
   if Code < 0 then RetCode := SioError( Code )
   else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
      begin (* Port Error *)
         if (Code and FramingError) <> 0 then writeln('Framing Error');
         if (Code and ParityError)  <> 0 then writeln('Parity Error');
         if (Code and OverrunError) <> 0 then writeln('Overrun Error')
      end
end;

(*** Transmits CAN's ***)

Procedure TxCAN(Port:Integer);
const
  CAN = $18;
var
  I : Integer;
  Code : Integer;
begin
  for I:=1 to 6 do Code := SioPutc(Port,chr(CAN));
end;


end.