{ Functions calls used from the fossil revision 5 documentation }
{ will work with any proper fossil driver {eg: X00, and OPUSCOMM }
{ PNum=0 for COM1, 1 for COM2, etc }

UNIT FOSSIL;

INTERFACE

USES Dos;

PROCEDURE SetBaudRate(PNum : Word; A : LongInt);
{  Set baud rate, 300/600/1200/2400/4800/9600/19200/38400 supported}

PROCEDURE TransmitChar(PNum : Word; A : Char);
{  Character is queued for transmission}

FUNCTION TxCharNoWait(Pnum : Word; A : Char) : BOOLEAN;
{  Try to send char.  Returns true if sent, false if buffer full}

FUNCTION ReceiveChar(PNum : Word) : Char;
{  Next char in input buffer returned, waits if none avail}

FUNCTION SerialStatus(PNum : Word) : Word;
{  AH bit 6, 1=output buffer empty
   AH bit 5, 1=output buffer not full
   AH bit 1, 1=input buffer overrun
   AH bit 0, 1=characters in input buffer
   AL bit 7, 1=carrier detect
   AL bit 3, 1=always}

FUNCTION OpenFossil(PNum : Word) : Boolean;
{  Open & init fossil. Returns true if a fossil device is loaded }

PROCEDURE CloseFossil(PNum : Word);
{  Disengage fossil from com port. DTR not changed}

PROCEDURE SetDTR(PNum : Word; A : Boolean);
{  Raise or lower DTR}

PROCEDURE FlushOutput(PNum : Word);
{  Wait for all output to complete}

PROCEDURE PurgeOutput(PNum : Word);
{  Zero output buffer and return immediately. Chars in buffer lost}

PROCEDURE PurgeInput(PNum : Word);
{  Zero input buffer and return immediately.  Chars in buffer lost}

FUNCTION CarrierDetect(PNum : Word) : Boolean;
{  Returns true if there is carrier detect }

FUNCTION SerialInput(PNum : Word) : Boolean;
{  Returns true if there is a character ready to be input }

PROCEDURE WriteChar(c : Char);
{  Write char to screen only with ANSI support}

PROCEDURE FlowControl(PNum : Word; A : Byte);
{  Enable/Disable com port flow control}

{-------------------------------------------------------------------------}

IMPLEMENTATION

VAR Reg : Registers; { Saves on stack usage later }

PROCEDURE SetBaudRate;
BEGIN
  WITH Reg DO BEGIN
    AH := 0;
    DX := PNum;
    AL := $63;
    IF A=38400 THEN AL:=$23 ELSE
    CASE A OF
      300   : AL := $43;
      600   : AL := $63;
      1200  : AL := $83;
      2400  : AL := $A3;
      4800  : AL := $C3;
      9600  : AL := $E3;
      19200 : AL := $03;
    END;
    Intr($14, Reg);
  END;
END;

PROCEDURE TransmitChar;
BEGIN
  Reg.AH := 1;
  Reg.DX := PNum;
  Reg.AL := Ord(A);
  Intr($14, Reg);
END;

FUNCTION TxCharNoWait;
BEGIN
  Reg.AH := $0B;
  Reg.DX := PNum;
  Intr($14,Reg);
  TxCharNoWait := (Reg.AX = 1);
END;

FUNCTION ReceiveChar;
BEGIN
  Reg.AH := 2;
  Reg.DX := PNum;
  Intr($14,Reg);
  ReceiveChar := Chr(Reg.AL);
END;

FUNCTION SerialStatus;
BEGIN
  Reg.AH := 3;
  Reg.DX := PNum;
  Intr($14,Reg);
  SerialStatus := Reg.AX;
END;

FUNCTION OpenFossil;
BEGIN
  Reg.AH := 4;
  Reg.DX := PNum;
  Intr($14,Reg);
  OpenFossil := Reg.AX = $1954;
END;

PROCEDURE CloseFossil;
BEGIN
  Reg.AH := 5;
  Reg.DX := PNum;
  Intr($14,Reg);
END;

PROCEDURE SetDTR;
BEGIN
  Reg.AH := 6;
  Reg.DX := PNum;
  Reg.AL := Byte(A);
  Intr($14,Reg);
END;

PROCEDURE FlushOutput;
BEGIN
  Reg.AH := 8;
  Reg.DX := PNum;
  Intr($14,Reg);
END;

PROCEDURE PurgeOutput;
BEGIN
  Reg.AH := 9;
  Reg.DX := PNum;
  Intr($14,Reg);
END;

PROCEDURE PurgeInput;
BEGIN
  Reg.AH := $0A;
  Reg.DX := PNum;
  Intr($14,Reg);
END;

FUNCTION CarrierDetect;
BEGIN
  Reg.AH := 3;
  Reg.DX := PNum;
  Intr($14,Reg);
  CarrierDetect := (Reg.AL AND $80) > 0;
END;

FUNCTION SerialInput;
BEGIN
  Reg.AH := 3;
  Reg.DX := PNum;
  Intr($14,Reg);
  SerialInput := (Reg.AH And 1) > 0;
END;

PROCEDURE WriteChar;
BEGIN
  Reg.AH := $13;
  Reg.AL := ORD(c);
  Intr($14,Reg);
END;

PROCEDURE FlowControl;
BEGIN
  Reg.AH := $0F;
  Reg.DX := PNum;
  Reg.AL := A;
  Intr($14, Reg);
END;

END.