'===========================================================================
' Subject: ACCESSING FOSSIL IN BASIC         Date: 02-14-93 (21:39)       
' Author:  Coridon Henshaw                   Code: QB, PDS                
' Origin:  QuickBASIC ScrapBook            Packet: MODEM.ABC
'===========================================================================
DECLARE FUNCTION FossInit% (Port%)
DECLARE FUNCTION BlockRead$ (Port%)
DECLARE FUNCTION BlockWrite% (Port%, Buffer$)
DEFINT A-Z
 
'$INCLUDE: 'QB.BI'    or use QBX.BI for PDS

DIM SHARED Regs AS RegTypeX

FUNCTION BlockRead$ (Port)
Buffer$ = STRING$(32766, 0) 'Max 32766 bytes to read
Regs.cx = LEN(Buffer$)
Regs.dx = Port
Regs.es = VARSEG(Buffer$)   ' Change to SSEG for PDS
Regs.di = SADD(Buffer$)
CALL INTERRUPTX(&H14, Regs, Regs)
BlockRead$ = LEFT$(Buffer$, Regs.ax)
END FUNCTION

FUNCTION BlockWrite (Port, Buffer$)
Regs.cx = LEN(Buffer$)
Regs.dx = Port
Regs.es = VARSEG(Buffer$)  ' Change to SSEG for PDS
Regs.di = SADD(Buffer$)
CALL INTERRUPTX(&H14, Regs, Regs)
BlockWrite = Regs.ax 'Number of chars transfered
END FUNCTION

SUB FossDeInit (Port)
' Release the FOSSIL device driver
Regs.ax = &H500
Regs.dx = Port
INTERRUPTX &H14, Regs, Regs
END SUB

FUNCTION FossInit (Port)
 
' Initialize the FOSSIL device driver
'
' dx = Communications port number (0-3)
' ah = &H04    Fossil Function Number - Initialize FOSSIL driver
'                                       (Raises DTR in the porcess)
 
Regs.dx = Port
Regs.ax = &H400
CALL INTERRUPTX(&H14, Regs, Regs)
 
IF Regs.ax <> &H1954 THEN
   FossInit = False 'Fossil Not Found
END IF
 
FossInit = True
 
END FUNCTION

SUB SetDtr (Port, DtrStatus)
Regs.dx = Port 'Set carrier detect low or high
SELECT CASE DtrStatus
    CASE 0
    Regs.ax = &H600
    CASE 1
    Regs.ax = &H601
    CASE ELSE
    Regs.ax = &H600
    BEEP
END SELECT
INTERRUPTX &H14, Regs, Regs
END SUB

SUB SetFlowControl (Port, Control)
Regs.dx = Port
SELECT CASE Control
 CASE 1 'Xon/Xoff on transmit
  Regs.ax = &H601
 CASE 2 'CTS/RTS
  Regs.ax = &H602
 CASE 3 'Xon/Xoff on recieve
  Regs.ax = &H608
END SELECT
CALL INTERRUPTX(&H14, Regs, Regs)
END SUB

SUB SetPortParams (Port, Bps AS LONG, Bits, Stops, Parity$)
Regs.dx = Port
Regs.ax = 0
SELECT CASE Bps
    CASE 300
    Regs.ax = (Regs.ax OR &H40)
    CASE 600
    Regs.ax = (Regs.ax OR &H60)
    CASE 1200
    Regs.ax = (Regs.ax OR &H80)
    CASE 2400
    Regs.ax = (Regs.ax OR &HA0)
    CASE 4800
    Regs.ax = (Regs.ax OR &HC0)
    CASE 9600
    Regs.ax = (Regs.ax OR &HE0)
    CASE 19200
    Regs.ax = (Regs.ax OR &H0)
    CASE 38400
    Regs.ax = (Regs.ax OR &H20)
    CASE ELSE
    Regs.ax = (Regs.ax OR &HA0)
    'Default to 2400 baud
END SELECT
 
SELECT CASE Bits
    CASE 5
    Regs.ax = (Regs.ax OR &H0)
    CASE 6
    Regs.ax = (Regs.ax OR &H1)
    CASE 7
    Regs.ax = (Regs.ax OR &H2)
    CASE 8
    Regs.ax = (Regs.ax OR &H3)
    CASE ELSE
    Regs.ax = (Regs.ax OR &H3)
    'Default to 8 bits
END SELECT
 
SELECT CASE Stops
    CASE 1
    Regs.ax = (Regs.ax OR &H0)
    CASE 2
    Regs.ax = (Regs.ax OR &H4)
    CASE ELSE
    Regs.ax = (Regs.ax OR &H0)
    'Default to 1 stop bit
END SELECT
 
SELECT CASE UCASE$(Parity$)
    CASE "N"
    Regs.ax = (Regs.ax OR &H0)
    CASE "O"
    Regs.ax = (Regs.ax OR &H8)
    CASE "E"
    Regs.ax = (Regs.ax OR &H18)
    CASE ELSE
    Regs.ax = (Regs.ax OR &H0)
    ' Default to no parity
END SELECT
Regs.dx = Port
INTERRUPTX &H14, Regs, Regs
END SUB