(* Fossil Support, Runs pretty good since i had to use parts from iniquity *)
(* and other stuff.  Works well with Netmodem.                             *)

unit fossil;

interface


var
  Comm_Port: word;
  b: byte;

function  Comm_Init(baud:longint;port:byte):boolean;
procedure comm_deinit;
function  carrier: boolean;
procedure awrite(const s: string);
procedure awriteln(const s: string);
function  dataavailable: boolean;
Function  GetChar : Byte;
procedure send(c: char);
function  checkRING: boolean;
procedure FlushOutBuffer;
procedure FlushInBuffer;
procedure comm_DTR(b: boolean);

implementation


Function modemInit(port, baud: word): Boolean;
var
  Temp: Word;

begin
    asm
    mov ah, $04
    mov bx, $00
    mov dx, comm_Port
    int $14
    mov temp, ax
    end;
     modeminit:=temp=$1954;
     Case Baud div 10 of
          30:  b:=$43;
          60:  b:=$63;
          120: b:=$83;
          240: b:=$A3;
          480: b:=$C3;
          960: b:=$E3;
          1920:b:=$03;
          3840:b:=$23;
   end;
     asm
        mov ah, 00
        mov al, b
        mov dx, Comm_Port
        int $14
        end;
end;

function  Comm_Init(baud:longint;port:byte):boolean;
begin
  comm_port:=port-1;
  comm_init:=modemInit(comm_port, baud);
end;

procedure awrite(const s: string);
var b: byte;
begin
  for b:=1 to length(s) do send(s[b]);
end;

procedure awriteln(const s: string);
var b: byte;
begin
  awrite(s+#10#13);
end;

function dataavailable: boolean;
Begin
  Asm
    mov ah, $03
    mov dx, comm_port
    int $14
    mov b, ah
  End;
  If (B And 1)=1 Then
    dataavailable:=True
  Else dataavailable:=False;
end;

function getchar:byte;
var c:char;
begin
  b:=0;
  Asm
    mov ah, $03
    mov dx, comm_port
    int $14
    mov b, ah
  End;
  If (B And 1)=1 Then
    Begin
      Asm
        mov ah, $02
        mov dx, comm_port
        int $14
        mov b, al
      End;
      c:=Chr(B);
    End;
getchar:=ord(C);
end;

procedure send(c: char);
begin
  B:=Ord(c);
  Asm
    mov al, B
    mov dx, comm_port
    mov ah, $01
    int $14
  End;
end;

function carrier:boolean;
begin
  Asm
    mov ah, $03
    mov dx, comm_port
    int $14
    mov b, al
  End;
  If (B And $80)<>0 Then
    carrier:=True
  Else carrier:=False;
end;

procedure comm_deinit;
begin
  Asm
    mov ah, $05
    mov dx, comm_port
    int $14
  End;
end;

function checkRIng: boolean;
const
  RI = $40;
begin
  Asm
    mov ah, 03h
    mov dx, comm_port
    int 14h
    mov b, al
  End;
  checkring := (b AND RI) = RI;
end;

procedure FlushInBuffer;
var c: array[1..8064] of byte;
begin
  Asm
    mov ah, $0A
    mov dx, comm_port
    int $14
  End;
end;

procedure flushoutbuffer;
begin
    asm
    mov ah,9
    mov dx,comm_port;
    int $14
    end;
end;


procedure comm_DTR(b: boolean);
var
  x: byte;
begin
  if b=true then x:=1 else x:=0;
  Asm
    mov dx, comm_port
    mov al, x
    mov ah, $06
    int 14h
  End;
end;

begin
  comm_port:=0;
  b:=0;
end.

