{
 ßßßßßßßß  ßßßßßß    ßß   ßß
   ßß     ßß   ßß   ßß  ßß
  ßß     ßß   ßßß  ßßßßß  The DoorKit!
 ßß     ßß   ßß   ßß  ßß
ßß     ßßßßßß    ßß    ßß
The BBS Door Development Kit By The People - For The People!


   Feel free to modify or optimize this code at will. All I ask is that if
   find a better way to do things (and you will), please send me a copy of
   your modifications. Thanks in advance!....Larry L. Athey....}

{$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
UNIT DIGIBORD;

INTERFACE

USES DOS;

TYPE
  Idarray = ARRAY[1..8] OF CHAR;

VAR
  AsyncStat : WORD;
  dport_num : INTEGER;
  nameptr   : ^idarray;
  OutReady  : BOOLEAN;

FUNCTION  Digi_Init_Driver : BOOLEAN;
FUNCTION  Digi_Deinit_Driver : BOOLEAN;
FUNCTION  Digi_Buffer_Check : BOOLEAN;
PROCEDURE Digi_Send(C : CHAR);
FUNCTION  Digi_Receive(VAR C : CHAR) : BOOLEAN;
FUNCTION  Digi_Carrier_Present : BOOLEAN;
PROCEDURE Digi_Set_Modem;
FUNCTION  Digi_Set_Baud(N : LONGINT ; WordSize : BYTE ; Parity : CHAR ; StopBits : BYTE) : BOOLEAN;
PROCEDURE Digi_Flush_IO;
PROCEDURE Digi_Flush_Input;
PROCEDURE Digi_Flush_Output;
PROCEDURE Digi_Get_Info(VAR DriverName : STRING);
PROCEDURE EnableTimeOutError;
PROCEDURE Digi_Break(StatusCode : WORD);

IMPLEMENTATION

CONST
  dtrmask = 1;
  rtsmask = 2;

TYPE
  BytePtr = ^BYTE;

VAR
  EBIOSok,DTRok,RTSok    : BOOLEAN;
  CharReadyP : BytePtr;

FUNCTION digi_Init_driver : BOOLEAN;
VAR
 regs : REGISTERS;
BEGIN;
 WITH regs DO                         { Get Channel Parameters }
   BEGIN
     ah := $0C;
     dx := dport_num;
   END;
 INTR($14,regs);
 IF regs.ah = $FF THEN
   digi_init_driver := FALSE
 ELSE
   digi_init_driver := TRUE;
                                  { Checks for extended Bios }
 asm
   mov ah,$F4
   mov al,$00
   mov dx,dport_num
   INT $14
 END;
 IF regs.ax = $000 THEN
   EbiosOk := TRUE
 ELSE
   EbiosOk := FALSE;

 WITH regs DO                         { checks modem dtr/rts status }
   BEGIN
     ah := $05;
     al := $00;
     dx := dport_num;
   END;
 INTR($14,regs);
 IF (regs.bl AND DTRmask) <> $00 THEN
   DTRok := TRUE
 ELSE
   DTRok := FALSE;
 IF (regs.bl AND RTSmask) <> $00 THEN
   RTSok := TRUE
 ELSE
   RTSok := FALSE;

 OutReady := FALSE;
END;

FUNCTION  digi_deinit_driver;  { A do nada routine, no deinit calls exist. }
BEGIN
 digi_deinit_driver := TRUE;
END;

FUNCTION digi_buffer_check : BOOLEAN;
VAR
 regs : REGISTERS;
BEGIN;
 WITH regs DO
   BEGIN
     ah := $03;
     dx := dport_num;
   END;
 INTR($14,regs);
 IF (regs.ah AND $01) <> $00 THEN   { data ready bit               }
   digi_buffer_check := TRUE        { checks if byte ready to send }
 ELSE
   digi_buffer_check := FALSE;
END;

PROCEDURE digi_send(c : CHAR);
VAR
 regs : REGISTERS;
BEGIN;
 WITH regs DO
  BEGIN
    ah := $01;
    al := BYTE(c);
    dx := dport_num;
  END;
 INTR($14,regs);
                               { bit 5 set on = buffer space avail }
 IF (regs.ah AND $20) <> $00 THEN
   OutReady := TRUE
 ELSE
   OutReady := FALSE;
END;

FUNCTION digi_receive(VAR c : CHAR) : BOOLEAN;
VAR
 regs : REGISTERS;
BEGIN;
 c := #0;
 digi_receive := FALSE;
 IF digi_buffer_check THEN
  BEGIN
    WITH regs DO
    BEGIN
      ah := $02;
      dx := dport_num;
    END;
    INTR($14,regs);
    IF (regs.ah AND $8E) = $00 THEN
      BEGIN
        c := CHR(regs.al);
        digi_receive := TRUE;
      END;
  END;
END;

FUNCTION digi_carrier_present : BOOLEAN;
VAR
 regs : REGISTERS;
BEGIN;
 WITH regs DO
   BEGIN
     ah := $03;
     dx := dport_num;
   END;
 INTR($14,regs);
 IF (regs.al AND $80) <> $00 THEN      { carrier present bit }
   digi_carrier_present := TRUE
 ELSE
   digi_carrier_present := FALSE;
 IF (regs.ah AND $20) <> $00 THEN      { bit 5 set on = buffer space avail }
   OutReady := TRUE                    { thus can check if out buffer ready}
 ELSE
   OutReady := FALSE;
END;

FUNCTION ExtBaud(n : LONGINT) : BYTE;
VAR
 b : BYTE;
 w : WORD;
BEGIN
 b := $00;
 w := n;

 IF n > 76800 THEN   { 115200 }
   b := $0C
 ELSE
 IF n > 57600 THEN   {  76800 }
   b := $0B
 ELSE
   CASE w OF
     300  : b := $02;
     600  : b := $03;
     1200 : b := $04;
     1800 : b := $11;
     2400 : b := $05;
     4800 : b := $06;
     4801..9600 :  b := $07;
     9601..19200 :  b := $08;
     19201..38400 : b := $09;
     38401..57600 : b := $0A;
   END;
  ExtBaud := b;
END;

PROCEDURE digi_set_modem;
VAR
  regs : REGISTERS;
BEGIN
  WITH regs DO
   BEGIN
     dx := dport_num;
     ah := $05;
     al := $01;
     IF dtrok THEN bl := bl OR dtrmask;
     IF rtsok THEN bl := bl OR rtsmask;
   END;
  INTR($14,regs);
END;

{ This is included for completeness only }
{ Most sysops don't want a door to reinitiallize their board }
{ so this is by passed.                                      }
FUNCTION digi_set_baud;      { new form digiboard init }
VAR
  regs : REGISTERS;
BEGIN;

  WITH regs DO
   BEGIN
     ah := $04;
     al := $00;
     dx := dport_num;
     CASE parity OF
      'N' : bh := $00;
      'O' : bh := $01;
      'E' : bh := $02;
     END;                  {0 = none/ 1 = odd / 2 = even }
     CASE stopbits OF
       1 : bl := $00;
       2 : bl := $01;
     END;
     CASE wordsize OF
       5 : ch := $00;
       6 : ch := $01;
       7 : ch := $02;
       8 : ch := $03;
     END;
     cl := ExtBaud(n);      { set baud rate }
  END;
  INTR($14,regs);
  IF regs.ah = $FF THEN
    digi_set_baud := FALSE
  ELSE
   BEGIN
    digi_set_baud := TRUE;
    digi_set_modem;
   END;
END;

PROCEDURE digi_flush_io;
VAR
 regs : REGISTERS;
BEGIN;
 regs.ah := $09;
 regs.dx := dport_num;
 INTR($14,regs);
END;

PROCEDURE digi_flush_input;
VAR
 regs : REGISTERS;
BEGIN;
 regs.ah := $10;
 regs.dx := dport_num;
 INTR($14,regs);
END;

PROCEDURE digi_flush_output;
VAR
 regs : REGISTERS;
BEGIN;
 regs.ah := $11;
 regs.dx := dport_num;
 INTR($14,regs);
END;

PROCEDURE digi_Get_Info(VAR drivername : STRING);
CONST
 dname : ARRAY[1..5] OF
  STRING [6] = ('COM/Xi','MC/Xi', 'PC/Xe', 'PC/Xi', 'PC/Xm' );
VAR
 i : BYTE;
 regs : REGISTERS;
 d,s,o : STRING;
 versno : WORD;
BEGIN;
 versno := 0;
 d := '';s := '';o := ' ';
 WITH regs DO
  BEGIN
    ah := $06;
    al := $ff;
    dx := dport_num;
  END;
 INTR($14,regs);
 nameptr := PTR(regs.es,regs.bx);
 i := 1;
 WHILE (i < 8) AND (nameptr^[i] <> #0)  DO
   INC(i);
 MOVE(nameptr^, d[1], i);
 d[0] := CHAR(i);

 WITH regs DO
  BEGIN
    ah := $06;
    al := $01;
    dx := dport_num;
  END;
 INTR($14,regs);
 IF regs.ah <> $ff THEN
  BEGIN
    versno := regs.bx;
    STR(versno,o);
    s := ' Version[' + o + '] : ';
    STR(regs.ax,o);
  END;
 d := d + s;

 s := '';

 WITH regs DO
  BEGIN
    ah := $06;
    al := $02;
    bx := $000;
    dx := dport_num;
  END;
 INTR($14,regs);
 IF regs.ah <> $ff THEN
   IF regs.al IN [$01..$05] THEN s := dname[regs.al]
   ELSE STR(regs.al,s);
 drivername := d + s + o;

END;

PROCEDURE EnableTimeOutError;
VAR
 regs : REGISTERS;
BEGIN;
 WITH regs DO
  BEGIN
    ah := $20;
    al := $01;
    dx := dport_num;
  END;
 INTR($14,regs);
END;

PROCEDURE Digi_Break(StatusCode : WORD);  { send break }
VAR
 regs : REGISTERS;
BEGIN;
 WITH regs DO
  BEGIN
    ah := $07;
    al := $00;       { defaults 250 millisecs }
    dx := dport_num;
  END;
 INTR($14,regs);
 AsyncStat := StatusCode;
END;
    
END.
