Unit IOPorts;

{***************************************************************************}

{* Handles the keyboard, COM1, COM2, and the modem.

{***************************************************************************}



interface

{***************************************************************************}

function  BaudSwitch(Port: integer; Baud: integer): boolean;

function  Disconnected(Port: integer): boolean;

Procedure ErrSayL(InStr: string);

procedure FlushInputBuff(PortNum: integer);

procedure FlushBuffs(PortNum: integer);

function  GetChar(PortNum: integer; var PortChar: char): boolean;

procedure InitPort(PortNum: integer);

function  PortInStr(PortNum: integer): string;

procedure PutChar(PortNum: integer; OutChar: char);

procedure PutOutputs;

procedure PutStr(PortNum: integer; OutStr: string);

function  Ringing(Port: integer): boolean;

procedure Say(SayStr: string);

procedure SayL(SayStr: string);

function  SeeChar(var OutChar: char): boolean;

Procedure ShowReplies(PortNum: integer);



implementation

{***************************************************************************}

uses

  BBSGlbls,

  Crt,

  Disk, {* for ErrSayL *}

  Glob,

  LctBBS,

  LctHayes,

  LctKrnl,

  LctSupp,

  Misc,

  Monitor,

  Data;



function  BaudSwitch(Port: integer; Baud: integer): boolean;

{***************************************************************************}

{* CommSetup screws up during LctPut -- don't use.

{***************************************************************************}

begin

  BaudSwitch := CommOpen(Port, Baud, 'N', 8, 1, BufSize_G, BufSize_G, true);

end;



function  Disconnected(Port: integer): boolean;

{***************************************************************************}

{* p 34 LiteComm Toolbox

{***************************************************************************}

var

  Stat: byte;

begin

  if Port = 0 then

    begin

      Disconnected := false;

      exit;

    end;

  Stat := ModemStatus(Port);

  Disconnected := Stat and Bit5 = 0; {* Bit5 *}

end;



Procedure ErrSayL(InStr: string);

{***************************************************************************}

var

  EL: text;

begin

  SayL(Beep+InStr);

  if FileOpen('A', ErrorLog, EL) = 0 then

    begin

      writeln(EL, InStr);

      close(EL);

    end;

end;



procedure FlushInputBuff(PortNum: integer);

{***************************************************************************}

var

  FlushOK: boolean;

begin

  FlushOK := PurgeRxBuff(PortNum);

  if not(FlushOK) then

    writeln(#7,#7,#7,'PurgeRxBuff failed!!!');

end;





procedure FlushBuffs(PortNum: integer);

{***************************************************************************}

var

  FlushOK: boolean;

begin

  FlushOK := PurgeTxBuff(PortNum);

  if not(FlushOK) then

    writeln(#7,#7,#7,'PurgeTxBuff failed!!!');

  FlushOK := PurgeRxBuff(PortNum);

  if not(FlushOK) then

    writeln(#7,#7,#7,'PurgeRxBuff failed!!!');

end;



function  GetChar(PortNum: integer; var PortChar: char): boolean;

{***************************************************************************}

var

  CharFound: boolean;

  PortByte: byte;

begin

  CharFound := false;

  case PortNum of

    0:  begin

          if keypressed then

            begin

              CharFound := true;

              PortChar := readkey;

            end;

        end;

    1:  begin

          CharFound := LctGet(1, PortByte);

          PortChar := char(PortByte);

        end;

    2:  begin

          CharFound := LctGet(2, PortByte);

          PortChar := char(PortByte);

        end;

    else

      write(#7);

  end; {case}

  GetChar := CharFound;

end;



Procedure InitPort(PortNum: integer);

{***************************************************************************}

begin

  if PortNum = 0 then

    exit;

  Monitor.WrL(PortNum, 'Initializing Port '+StrInt(PortNum)+'...');

  if not(CommOpen(PortNum, BaudInit, 'N', 8, 1, BufSize_G, BufSize_G,

    true)) then

      Monitor.WrL(PortNum, #7+ #7+ #7+ 'Port '+StrInt(PortNum)+' did not open!!!');

end;



Function PortInStr(PortNum: integer): string;

{***************************************************************************}

var

  InStr: string;

  InChar: char;

  Done: boolean;

begin

  InStr := '';

  Done := false;

  repeat

    if GetChar(PortNum, InChar) then

      InStr := InStr + InChar

    else

      begin

        Delay(ModemDelay);

        if GetChar(PortNum, InChar) then

          InStr := InStr + InChar

        else

          Done := true;

      end;

    if length(InStr) = 255 then

      Done := true;

    if InChar = CntrlEntr then

      Done := true;

  until Done;

  PortInStr := InStr;

end;



procedure PutChar(PortNum: integer; OutChar: char);

{***************************************************************************}

var

  Purged: boolean;

  PutOK: boolean;

  TF: text;

  Test: integer;

  Counter: integer;

begin

  if PortNum = 0 then

    exit;

  Counter := 0;

  Purged := true;

  repeat

    Test := BytesInOutput(PortNum);

    Inc(Counter);

    if Counter = 20000 then

      Purged := PurgeTxBuff(PortNum);

  until (BytesInOutput(PortNum) < 50) or not(Purged);

{*  write(ModemStatus(PortNum),'  ', XoffRecd(PortNum), '     '); *}

  PutOK := LctPut(PortNum, ord(OutChar));

  if not(PutOK) then

    begin

      writeln(#7,#7,#7, 'PutChar was unsuccessful!!!');

      writeln(BytesInOutput(PortNum));

    end;

end;



Procedure PutOutputs;

{***************************************************************************}

var

  alpha,

  bravo: integer;

  OutChar: char;

begin

  for alpha := 0 to NumPorts do

    if PortOutStr[alpha] <> '' then

      begin

        OutChar :=  PortOutStr[alpha, 1];

        PutChar(alpha, OutChar);

        if not((alpha <> 0) and (Area[alpha, AreaTOS[alpha]] = WaitConnect))

          then

            Monitor.Wr(alpha, OutChar);

        PortOutStr[alpha]

          := copy(PortOutStr[alpha], 2, length(PortOutStr[alpha]) - 1);

      end;

end;



procedure PutStr(PortNum: integer; OutStr: string);

{***************************************************************************}

begin

  while OutStr <> '' do

    begin

      PutChar(PortNum, OutStr[1]);

      OutStr := copy(OutStr, 2, length(OutStr) - 1);

    end;

end;



procedure Say(SayStr: string);

{***************************************************************************}

begin

  while (length(PortOutStr[Port]) + length(SayStr) > 255) do

    PutOutputs;

  PortOutStr[Port] := PortOutStr[Port] + SayStr;

end;



function  Ringing(Port: integer): boolean;

{***************************************************************************}

{* p 34 LiteComm Toolbox

{***************************************************************************}

var

  Stat: byte;

begin

  if Port = 0 then

    begin

      Ringing := false;

      exit;

    end;

  Stat := ModemStatus(Port);

  Ringing := Stat and Bit2 = Bit2;

end;



procedure SayL(SayStr: string);

{***************************************************************************}

begin

  Say(SayStr + Enter + CntrlEntr);

end;



function SeeChar(var OutChar: char): boolean;

{***************************************************************************}

begin

  if SessInStr[Port] <> '' then

    begin

      SeeChar := true;

      OutChar := SessInStr[Port, 1];

      SessInStr[Port] := copy(SessInStr[Port], 2, length(SessInStr[Port]) - 1);

    end

  else

    SeeChar := false;

end;



Procedure ShowReplies(PortNum: integer);

{***************************************************************************}

var

  PortStr: string;

begin

  repeat

    PortStr := PortInStr(PortNum);

    if PortStr <> '' then

      writeln('Modem reply:  "'+PortStr+'"');

  until PortStr = '';

end;



{***************************************************************************}

{***************************************************************************}

{***************************************************************************}

begin

end.