home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBNWS104.ZIP / FOSSIL.ZIP / FOSSIL1.BAS next >
Encoding:
BASIC Source File  |  1990-09-03  |  4.6 KB  |  180 lines
  1. 'Baud and Commport should be global variables already set in the main
  2. 'module.  Baud should probably be a long integer.
  3.  
  4. 'LocalPrint (Text$) should be a Sub that prints Text$ on the local
  5. 'screen
  6.  
  7. 'These should be declared in your FOSSIL-module-level code
  8. DIM SHARED InRegs2 AS RegType2
  9. DIM SHARED InReg AS RegType
  10. DIM SHARED OutRegs2 AS RegType2
  11. DIM SHARED OutReg AS RegType
  12.  
  13. '
  14. SUB Deinit        'Deinitialize the FOSSIL..._always_ deinit on program exit
  15.  
  16.   InReg.AX = 1280
  17.   InReg.DX = Commport
  18.   Interrupt &H14, InReg, OutReg
  19.  
  20. END SUB
  21.  
  22. SUB FossilCD (Status)  'Check modem status, check for carrier
  23.  
  24. STATIC InRegs AS RegType
  25. STATIC OutRegs AS RegType
  26.  
  27. InRegs.AX = 768    'Remember, AX is (AH * 256) + AL
  28. InRegs.DX = Commport
  29. Interrupt &H14, InRegs, OutRegs
  30. Status = OutRegs.AX / 256  'This gets us register AH's value
  31. 'Inputt = abs((Status AND 1 + Carrier[1]) > 0)  'Additional info if
  32. 'Outputt = abs((Status AND 32) > 0)             'anyone wants it
  33. 'NoOut=  abs((Status AND 64) > 0)<>0
  34. IF Baud THEN
  35.    IF ABS(((OutRegs.AX - (Status * 256)) AND 128) > 0) = 0 THEN
  36.                           '^                  ^--Carrier mask
  37.       DeInit              '|
  38.       END 'Lost carrier    '\__Subtracting AH * 256 from AX gives us AL
  39.    END IF
  40. END IF
  41.  
  42. END SUB
  43.  
  44. '
  45. SUB FossilDTR (UpDown)     'UpDown=1 means DTR up...0 means DTR down
  46.  
  47. HowMany = 0
  48. Hangup:
  49. AH = &H6: AL = UpDown
  50. GOSUB DoItToIt
  51. IF UpDown = 1 THEN EXIT SUB
  52. SLEEP 1          'From here down we're checking to see if we cleared the
  53. AH = &H6: AL = 1 'line.  We'll try a few more times if not.
  54. GOSUB DoItToIt
  55. AH = &H3: AL = 0
  56. InReg.DX = Commport
  57. GOSUB DoItToIt
  58. IF ABS(((OutReg.AX - Status * 256) AND 128) > 0) = 0 THEN
  59.    AH = &H6
  60.    AL = 0
  61.    GOSUB DoItToIt
  62.    EXIT SUB
  63. END IF
  64. HowMany = HowMany + 1
  65. IF HowMany < 7 THEN
  66.   GOTO Hangup
  67.  ELSE
  68.   AH = &H6
  69.   AL = 0
  70.   GOSUB DoItToIt
  71.   EXIT SUB
  72. END IF
  73.  
  74. DoItToIt:
  75.  InReg.AX = AH * 256 + AL
  76.  InReg.DX = Commport
  77.  Interrupt &H14, InReg, OutReg
  78. RETURN
  79.  
  80. END SUB
  81.  
  82. '
  83. FUNCTION FossilGet$     'Equivalent of INKEY$ for FOSSIL
  84.  
  85. FossilGet$ = ""
  86. IF Baud THEN
  87.   FossilCD Status
  88.   IF ABS((Status AND 1 + 1) > 0) = 0 THEN EXIT SUB  'No input waiting
  89.   InReg.AX = 512
  90.   InReg.DX = Commport
  91.   Interrupt &H14, InReg, OutReg
  92.   FossilGet$ = CHR$((OutReg.AX - INT(OutReg.AX / 256) * 256))
  93. END IF
  94.  
  95. END SUB
  96.  
  97. '
  98. SUB FossilInit    'Initialize FOSSIL
  99.  
  100. InReg.AX = 1024
  101. InReg.DX = Commport
  102. Interrupt &H14, InReg, OutReg
  103.  
  104. IF OutReg.AX <> &H1954 THEN
  105.   Print "FOSSIL is braindead!"
  106.   DeInit
  107.   END
  108. END IF
  109.  
  110. InReg.AX = 4088                'Check FOSSIL.DOC for these...you may
  111. Interrupt &H14, InReg, OutReg  'want to modify these calls for your
  112. InReg.AX = 4096                'own setup
  113. Interrupt &H14, InReg, OutReg
  114.                           
  115.  
  116. END SUB
  117.  
  118. '
  119. SUB FossilPos (PutGet, Row, Col) 'PutGet=0 means put, =1 means get
  120.                                  'Use this instead of LOCATE if you
  121.                                  'print on local screen through CONS:
  122. InReg.DX = Row * 256 + Col
  123. InReg.AX = 4352 + ABS(PutGet)
  124. Interrupt &H14, InReg, OutReg
  125. IF PutGet THEN Row = OutReg.DX / 256: Col = OutReg.DX -_
  126.  INT(OutReg.DX / 256) * 256
  127.  
  128. END SUB
  129.  
  130. '
  131. SUB FossilPurge (OutIn)   'Purge input (OutIn=0=Out, 1=In, 2=Both)
  132.                           'Purges inbound and/or outbound FOSSIL
  133.                           'buffer(s)
  134.  
  135. IF OutIn = 0 THEN InReg.AX = 2304 ELSE InReg.AX = 2560
  136. GOSUB Purger
  137. IF OutIn = 2 THEN InReg.AX = 2304: GOSUB Purger
  138. EXIT SUB
  139.  
  140. Purger:
  141.  InReg.DX = Commport
  142.  Interrupt &H14, InReg, OutReg
  143. RETURN
  144.  
  145. END SUB
  146.  
  147. '
  148. SUB Hold             'Wait until output clears outbound FOSSIL buffer
  149.  
  150. IF Baud THEN
  151.  DO
  152.   FossilCD Status
  153.  LOOP UNTIL (ABS((Status AND 64) > 0))
  154. END IF
  155.  
  156. END SUB
  157.  
  158. '
  159. SUB ModemOut (Text$)     'Send a string to the modem
  160.  
  161.     IF Text$ = "" THEN EXIT SUB  'Goof-up protection
  162.  
  163.     IF Baud THEN
  164.         Temp = LEN(Text$)
  165.         FOR X = 1 TO Temp       'Put each char into outbound buffer
  166.           InReg.AX = (&HB * 256) + ASC(MID$(Text$, X, 1))
  167.           InReg.DX = Commport
  168.           DO
  169.             Interrupt &H14, InReg, OutReg
  170.             IF OutReg.AX = 0 THEN FossilCD Status  'Buffer was full
  171.           LOOP WHILE OutReg.AX = 0                 'Try again
  172.         NEXT
  173.     END IF
  174.     LocalPrint Text$         'Sub to print text locally (suggest CONS:)
  175.     IF Baud > 0 AND Baud < 4800 THEN Hold '<------------------------,
  176.                              'Optional, prevents excessive overrun__/
  177.                              'You might want to make dependent on length
  178.                              'of string sent
  179. END SUB
  180.