Bbs Design

 BBS: Inland Empire Archive
Date: 12-25-92 (11:20)             Number: 295
From: GLENN DELAHOY                Refer#: NONE
  To: DICK DENNISON                 Recvd: NO  
Subj: Bbs Design                     Conf: (2) Quik_Bas

 > We always need good code.

Ok you asked for it....

If your are writing a door for a bbs that uses the fossil
then you don't need to set the baud or handshaking as the
fossil, when restarted, will use the current settings.
Remember the fossil expects port 0 = COM1, port 1 = COM2
etc.  port 255 = local.


FUNCTION SetBaud (PortNum, Baud)
DIM inreg AS RegType, outreg AS RegType

'best to use open CONS for local output
IF PortNum = 255 THEN EXIT FUNCTION

 ' high 3 bits of AL
IF Baud = 38400 THEN inreg.ax = 35       ' 001 = 38400  ''
(Replaces old 150 baud mask)
IF Baud = 19200 THEN inreg.ax = 3        ' 000 = 19200  ''
(Replaces old 110 baud mask)
IF Baud = 9600 THEN inreg.ax = 227       ' 111 =  9600  ''
IF Baud = 4800 THEN inreg.ax = 195       ' 110 =  4800  ''
IF Baud = 2400 THEN inreg.ax = 163       ' 101 =  2400  ''
IF Baud = 1200 THEN inreg.ax = 131       ' 100 =  1200  ''
IF Baud = 600 THEN inreg.ax = 99         ' 011 =   600  ''
IF Baud = 300 THEN inreg.ax = 67         ' 010 =   300 baud

inreg.dx = PortNum
CALL Interrupt(&H14, inreg, outreg)
SetBaud = outreg.ax

' outreg.ax
' bit 7 carrier detect
'     6 output buffer empty
'     5 output buffer not full
'     4
'     3 always 1
'     2
'     1 input buffer overrun
'     0 characters in input buffer

END FUNCTION



FUNCTION StartFossil (PortNum)
DIM inreg AS RegType, outreg AS RegType

inreg.ax = &H400                        'FOSSIL function 04h
inreg.dx = PortNum                      'Port number (0=COM1)
inreg.flags = 512                       'Keeps interrupts enabled
CALL Interrupt(&H14, inreg, outreg)     'Call X00

'If installed X00 returns &H1954

IF outreg.ax = &H1954 THEN
StartFossil = outreg.bx \ 256
ELSE
StartFossil = 0
END IF

END FUNCTION



SUB WritePort (PortNum, Tx$)
DIM InRegX AS RegTypeX, OutRegX AS RegTypeX

IF PortNum = 255 THEN EXIT SUB

Buffer$ = Tx$

DO WHILE LEN(Buffer$) > 0

        'if not local then check for carrier before xmit
        IF CarrierDetect = 1 THEN
        IF (StatusRequest(PortNum) AND 128) <> 128 THEN ERROR 255
        END IF

InRegX.ax = &H1900
InRegX.cx = LEN(Buffer$)
InRegX.dx = PortNum
InRegX.es = SSEG(Buffer$)                             'qb 7.1
'InRegX.es = VARSEG(Buffer$)                           'qb 4.5
InRegX.di = SADD(Buffer$)
CALL InterruptX(&H14, InRegX, OutRegX)

'number of chars actually sent
numberchars = OutRegX.ax
Buffer$ = RIGHT$(Buffer$, LEN(Buffer$) - numberchars)
LOOP

' will attempt to move the whole string
' returns actual number of characters moved
' if not all characters are moved then
' keep looping until done

'   AH = 19h    Write block (transfer from user buffer to FOSSIL)
'
'           Parameters:
'               Entry:  CX = Maximum number of characters to transfer
'                       DX = Port number
'                       ES = Segment of user buffer
'                       DI = Offset into ES of user buffer
'               Exit:   AX = Number of characters actually transferred

END SUB


FUNCTION StatusRequest (PortNum)
DIM inreg AS RegType, outreg AS RegType

IF PortNum = 255 THEN
'dummy carrier for local
StatusRequest = 128
EXIT FUNCTION
END IF

inreg.ax = &H300
inreg.dx = PortNum
CALL Interrupt(&H14, inreg, outreg)
StatusRequest = outreg.ax

'                    AL = Modem status, where:
'                         Bit 0 = Delta clear to send (not reliable)
'                         Bit 1 = Delta data set ready (not reliable)
'                         Bit 2 = Delta data carrier detect (not reliable)
'                         Bit 3 = Always set to 1 upon return (DUMMY DCD)
'                         Bit 4 = Clear to send (CTS)
'                         Bit 5 = Data set ready (DSR)
'                         Bit 6 = Ring indicator (RI)
'                         Bit 7 = Data carrier detect (DCD)

'use bit 6 to detect the modem ringing

END FUNCTION



Regards,

Glenn

--- FMail 0.92
 * Origin: Rough Productions -V32- (059) 983 639 (3:635/572)