'===========================================================================
' Subject: QB FOSSIL ROUTINES                Date: 10-24-95 (21:28)       
' Author:  Bob Perkins                       Code: QB, PDS                
' Origin:  FidoNet QUIK_BAS Echo           Packet: MODEM.ABC
'===========================================================================
   '       -=-=-=-=-=-   Data for initfossil()   -=-=-=-=-=-=-
 '[initialize fossil driver]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'DTR is raised
 'returns 0 for successful, -1 for failure
 '
 '       -=-=-=-=-=-    Data for inituart()    -=-=-=-=-=-=-
 '[initialize uart]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'valid baud rates are 38400, 19200, 9600, 4800, 2400, 1200, 600, 300
 'parity% :   0=none   8=odd   24=even
 'stop%   :   0=1bit   4=2bits
 'wordlen%:   0=5bits  1=6bits  2=7bits  3=8bits
 'returns rs-232 status code bits in ah
 'bit0=RDA   (input data available in buffer)
 'bit1=OVRN  (data has been lost)
 'bit5=THRE  (room available in output buffer)
 'bit6=TSRE  (output buffer empty)
 'returns modem status bits in al
 'bit3 = always set
 'bit7 = carrier detect
 '
 '       -=-=-=-=-=-  Data for deinitfossil()  -=-=-=-=-=-=-
 '[deinitialize fossil driver]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'state of DTR is not affected, use setDTR() first to set desired state.
 'nothing returned
 '
 '       -=-=-=-=-=-     Data for setDTR()     -=-=-=-=-=-=-
 '[set state of DTR]
 'port%  = 0=com1, 1=com2, 2=com3, 3=com4
 'state% = 0 to lower,  1 to raise
 'nothing returned
 '
 '       -=-=-=-=-=-    Data for waitreceive   -=-=-=-=-=-=-
 '[get character from port with wait]
 'NOTE: Will not return until a character is received!
 '      Use check4char%() before calling!
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'returns ascii value of character received
 '
 '       -=-=-=-=-=-    Data for check4char    -=-=-=-=-=-=-
 '[non-destructive read-ahead]
 'Use before waitreceive() to make sure character available.
 '"peeks" at character without retrieving from buffer.
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'returns 0 for no character, or ascii value of char waiting in buffer
 '
 '       -=-=-=-=-=-     Data for sendchar%    -=-=-=-=-=-=-
 '[send character out port]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'returns 0 if successful, -1 if character rejected (buffer full)
 '
 '       -=-=-=-=-=-   Data for getdriverinfo  -=-=-=-=-=-=-
 '[get information about fossil driver]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'loads structure driverinfo with information about driver
 '
 '       -=-=-=-=-=-    Data for flushbuffer   -=-=-=-=-=-=-
 '[flush output buffer]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'flushes buffer, waiting until all characters have been sent
 'nothing returned
 '
 '       -=-=-=-=-=-  Data for purgeoutputbuff -=-=-=-=-=-=-
 '[purge output buffer]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'clears output buffer destroying any characters waiting to be sent.
 'nothing returned
 '
 '       -=-=-=-=-=-  Data for purgeinputbuff  -=-=-=-=-=-=-
 '[purge input buffer]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'clears input buffer destroying any characters waiting to be read.
 'nothing returned
 '
 '       -=-=-=-=-=-     Data for sendbreak    -=-=-=-=-=-=-
 '[toggle break]
 'port% = 0=com1, 1=com2, 2=com3, 3=com4
 'status:  1 = start sending break,  0 = stop sending break
 'nothing returned
 '
 '       -=-=-=-=-=-       Data for reboot     -=-=-=-=-=-=-
 '[fossil reboot]
 'if coldwarm% = 0 then cold boot  (memory check)
 'if coldwarm% = 1 then warm boot
 'nothing returned (obviously)
 '
 '       -=-=-=-=-=-     Data for writeansi    -=-=-=-=-=-=-
 '[writes character to screen with ANSI support]
 'nothing returned
 '       -=-=-=-=-=-  Data for writeansistrng  -=-=-=-=-=-=-
 '[writes a string of characters to the screen with ANSI]
 'uses calls to writeansi()
 'nothing returned
 '
 '       -=-=-=-=-=-    Data for getcurorpos   -=-=-=-=-=-=-
 '[get current cursor location]
 'current row returned in row%, column in column%
 '
 '       -=-=-=-=-=-    Data for setcurorpos   -=-=-=-=-=-=-
 '[set cursor location]
 'specify row% and column%
 'nothing returned
 '
 '
 TYPE driverinfo
   structsize AS INTEGER          'size of structure
   spec AS STRING * 1             'spec fossil conforms to
   revlevel AS STRING * 1         'rev level of fossil
   IDoffset AS INTEGER            'id string offset
   IDsegment AS INTEGER           'id string segment
   inputbuffsize AS INTEGER       'input buffer size in bytes
   inpbytesleft AS INTEGER        'bytes waiting in buffer
   outputbuffsize AS INTEGER      'output buffer size in bytes
   outbytesleft AS INTEGER        'bytes waiting in buffer
   screenwidth AS STRING * 1      'screen width
   screenlength AS STRING * 1     'screen length
   comp2modembaud AS STRING * 1   'computer to modem baud rate
 END TYPE
 DIM SHARED driverinfo AS driverinfo  'structure for getdriverinfo()
 '

 '$INCLUDE: 'qb.bi'
 DIM SHARED regs AS regtype
 '
 DECLARE FUNCTION initfossil% (port%)
 DECLARE SUB deinitfossil (port%)
 DECLARE FUNCTION inituart% (port%, baud&, parity%, stopbits%, wordlen%)
 DECLARE SUB setDTR (port%, state%)
 DECLARE FUNCTION waitreceive% (port%)
 DECLARE FUNCTION check4char% (port%)
 DECLARE FUNCTION sendchar% (port%, char%)
 DECLARE SUB getdriverinfo (port%)
 DECLARE SUB flushbuffer (port%)
 DECLARE SUB purgeoutputbuff (port%)
 DECLARE SUB purgeinputbuff (port%)
 DECLARE SUB sendbreak (port%, status%)
 DECLARE SUB reboot (coldwarm%)
 DECLARE SUB writeansi (char%)
 DECLARE SUB writeansistrng (ansistring$)
 DECLARE SUB setcursorpos (row%, column%)
 DECLARE SUB getcursorpos (row%, column%)
 DECLARE FUNCTION getblock% (buffer$, port%)
 DECLARE FUNCTION writeblock% (port%)
 '
 crlf$ = CHR$(13) + CHR$(10)
 ctrlx$ = CHR$(24)
 port% = 1        'com2:
 '......................... Initialize FOSSIL .........................
 IF initfossil%(port%) THEN PRINT "Fossil driver not loaded!": END
 '.......................... Initialize UART ...........................
 'com2:, 9600 baud, no parity, 1 stop bit, 8 data bits
 baud& = 9600: parity% = 0: stopbits% = 0: wordlen% = 3
 status% = inituart%(port%, baud&, parity%, stopbits%, wordlen%)
 '.................. Display Fossil driver ID string ...................
 getdriverinfo (port%)
 DEF SEG = driverinfo.IDsegment      'get fossil ID string
 CLS : x% = 0: PRINT "Fossil ID string = ";
 DO
   a% = PEEK(driverinfo.IDoffset% + x%)
   writeansi a%
   x% = x% + 1
 LOOP UNTIL a% = 0
 DEF SEG
 writeansistrng crlf$ + crlf$ + "To exit press CTRL-X" + crlf$
 '......................... Main Program Loop...........................
 'simple modem communications program...
 DO
  a$ = INKEY$
  IF LEN(a$) THEN
     DO
       test% = sendchar%(port%, ASC(a$))    'send until accepted
     LOOP WHILE test%
  END IF
  IF check4char%(port%) THEN
    char% = waitreceive(port%)
    writeansi char%
  END IF
 LOOP UNTIL a$ = ctrlx$
 '............................. Program End ............................
 '
 setDTR port%, 0       'lower DTR
 writeansistrng crlf$ + "FOSSIL deinitializing.  Program End."
 deinitfossil port%    'release fossil
 END

 FUNCTION check4char% (port%)
 'non-destructive read-ahead to peek and see if char waiting..
 regs.ax = &HC00
 regs.dx = port%
 interrupt &H14, regs, regs
 IF regs.ax = &HFFFF THEN
   check4char% = 0
 ELSE
   check4char% = regs.ax AND &HFF
 END IF
 END FUNCTION

 SUB deinitfossil (port%)
 'DTR is NOT affected
 regs.ax = &H500
 regs.dx = port%
 interrupt &H14, regs, regs
 END SUB

 SUB flushbuffer (port%)
 'flush buffer waiting until all output is done
 regs.ax = &H800
 regs.dx = port%
 interrupt &H14, regs, regs
 END SUB

 FUNCTION getblock% (buffer$, port%)
   DIM regsx AS regtypex
   regsx.ax = &H1800
   regsx.cx = LEN(buffer$)
   regsx.dx = port%
   regsx.es = VARSEG(buffer$)
   regsx.di = SADD(buffer$)
   interruptx &H14, regsx, regsx
   getblock% = regs.ax
 END FUNCTION

 SUB getcursorpos (row%, column%)
   regs.ax = &H1200
   interrupt &H14, regs, regs
   row% = (regs.dx AND &HFF00) \ 256
   column% = regs.dx AND &HFF
 END SUB

 SUB getdriverinfo (port%)
 DIM regsx AS regtypex
 regsx.ax = &H1B00
 regsx.dx = port%
 regsx.cx = LEN(driverinfo)
 regsx.es = VARSEG(driverinfo)
 regsx.di = VARPTR(driverinfo)
 interruptx &H14, regsx, regsx
 '
 ' AX = number of characters transferred
 ' CX = 3058h ("0X") (X00 FOSSIL only)
 ' DX = 2030h (" 0") (X00 FOSSIL only)
 '
 'structure driveinfo filled with data from call..
 END SUB

 FUNCTION initfossil% (port%)
 regs.ax = &H400
 regs.dx = port%
 interrupt &H14, regs, regs
 IF regs.ax = &H1954 THEN initfossil% = 0 ELSE initfossil% = -1
 END FUNCTION

 FUNCTION inituart% (port%, baud&, parity%, stopbits%, wordlen%)
 'regs.ah = 0, regs.al = parameters
 'regs.dx = port to init 0=com1, 1=com2, etc.. (255 for local testing)
 'parity = bits 4-3,  stopbits = bit 2,  wordlength = bits 1-0
   SELECT CASE baud&
     CASE 38400: baudrate% = 32  '001  bits 7-6-5
     CASE 19200: baudrate% = 0   '000
     CASE 9600: baudrate% = 224  '111
     CASE 4800: baudrate% = 192  '110
     CASE 2400: baudrate% = 160  '101
     CASE 1200: baudrate% = 128  '100
     CASE 600: baudrate% = 96    '011
     CASE 300: baudrate% = 64    '010
   END SELECT
 regs.ax = baudrate% + parity% + stopbits% + wordlen%
 regs.dx = port%
 interrupt &H14, regs, regs

 'Return: AH = RS-232 status code bits
 '            0: RDA - input data is available in buffer
 '            1: OVRN - data has been lost
 '            5: THRE - room is available in output buffer
 '            6: TSRE - output buffer empty
 '        AL = modem status bits
 '            3 : always 1
 '            7: DCD - carrier detect

 inituart% = regs.ax
 END FUNCTION

 SUB purgeinputbuff (port%)
 regs.ax = &HA00
 regs.dx = port%
 interrupt &H14, regs, regs
 END SUB

 SUB purgeoutputbuff (port%)
 regs.ax = &H900
 regs.dx = port%
 interrupt &H14, regs, regs
 END SUB

 SUB reboot (coldwarm%)
 'if coldwarm% = 0 then cold boot, 1 then warm boot.
 regs.ax = &H1700 + coldwarm%
 interrupt &H14, regs, regs
 END SUB

 SUB sendbreak (port%, status%)
 'status = 1 send break, status = 0 stop sending break
 regs.ax = &H1A00 + status%
 regs.dx = port%
 interrupt &H14, regs, regs
 END SUB

 FUNCTION sendchar% (port%, char%)
 'returns 0 if char accepted, -1 if not..
 regs.ax = &HB00 + char%
 regs.dx = port%
 interrupt &H14, regs, regs
 IF regs.ax = 0 THEN sendchar% = -1 ELSE sendchar% = 0
 END FUNCTION

 SUB setcursorpos (row%, column%)
   regs.ax = &H1100
   regs.dx = row% * 256 + column%
   interrupt &H14, regs, regs
 END SUB

 SUB setDTR (port%, state%)
 regs.ax = &H600 + state% 'state% = 0 for lower or 1 for raise
 regs.dx = port%
 interrupt &H14, regs, regs
 END SUB

 FUNCTION waitreceive% (port%)
 regs.ax = &H200
 regs.dx = port%
 interrupt &H14, regs, regs
 waitreceive% = regs.ax  'ah will be 0 so no need to AND with FFh
 END FUNCTION

 SUB writeansi (char%)
   regs.ax = &H1300 + char%
   interrupt &H14, regs, regs
 END SUB

 SUB writeansistrng (ansistring$)
   'calls writeansi() for each character in string
   FOR x% = 1 TO LEN(ansistring$)
     writeansi ASC((MID$(ansistring$, x%, 1)))
   NEXT x%
 END SUB