home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBFC100.ZIP / QBFCDEMO.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-10-20  |  10.0 KB  |  418 lines
  1. '*  QBFCDEMO.BAS
  2. '*--------------------------------------------------------------------------
  3. '*
  4. '*  Test program for the QBFCOMMS.BAS routines.
  5. '*
  6.  
  7. ' $INCLUDE: 'QBFCOMMS.BI'
  8.  
  9. DECLARE FUNCTION ConvertTime& (T$)
  10. DECLARE SUB Delay (DelaySecs&)
  11. DECLARE SUB Case1 ()
  12. DECLARE SUB Case2 ()
  13. DECLARE SUB Case3 ()
  14. DECLARE SUB Case4 ()
  15. DECLARE SUB Case5 ()
  16. DECLARE SUB Case6 ()
  17. DECLARE SUB Case7 ()
  18. DECLARE SUB Case8 ()
  19. DECLARE SUB Case9 ()
  20. DECLARE SUB CaseA ()
  21. DECLARE SUB CaseB ()
  22. DECLARE SUB CaseC ()
  23. DECLARE SUB CaseD ()
  24. DECLARE SUB CaseE ()
  25. DECLARE SUB CaseF ()
  26. DECLARE SUB CaseB ()
  27. DECLARE SUB CaseC ()
  28. DECLARE SUB CaseD ()
  29. DECLARE SUB CaseE ()
  30. DECLARE SUB CaseF ()
  31. DECLARE SUB CaseG ()
  32.  
  33. '*
  34. '*--------------------------------------------------------------------------
  35. '*
  36.       CrLf$ = CHR$(13) + CHR$(10)
  37.  
  38.       FossilStarted = FALSE
  39.  
  40.       DO
  41.      PRINT
  42.      PRINT "-- Demo Menu --"
  43.      PRINT "[1] Set Port Parameters ";
  44.      IF NOT FossilStarted THEN
  45.         PRINT "(NOT Set Yet...)"
  46.      ELSE
  47.         PRINT "(Now Port"; ComPort%; "at"; BaudRate&; "Baud)"
  48.      END IF
  49.      PRINT
  50.      PRINT "[2] Send Data - FossilPutchWait()     [B] Get a Key - FossilInkeyWait()"
  51.      PRINT "[3] Send Data - FossilPutch()         [C] Get Cursor Pos - FossilReadCursor()"
  52.      PRINT "[4] Send Data - FossilPutb()          [D] Move Cursor - FossilLocate()"
  53.      PRINT "[5] Receive Data - FossilGetch()      [E] Print - FossilAnsiPrint()"
  54.      PRINT "[6] Receive Data - FossilGetb()       [F] Print - FossilBIOSPrint()"
  55.      PRINT "[7] Test FossilPeek()                 [G] Reboot - FossilReboot()"
  56.      PRINT "[8] Set/Reset DTR - FossilDTR()"
  57.      PRINT "[9] Info - FossilInfo()"
  58.      PRINT "[A] Get a Key - FossilInkey()"
  59.      PRINT
  60.      PRINT "[Q] Quit to DOS"
  61.      PRINT
  62.      PRINT "Select: ";
  63.  
  64.      DO
  65.         A$ = INKEY$
  66.         A$ = UCASE$(A$)
  67.      LOOP WHILE A$ = "" OR INSTR("123456789ABCDEFGQ", A$) = 0
  68.      PRINT A$
  69.      PRINT
  70.  
  71.      IF VAL(A$) > 1 AND VAL(A$) < 10 AND NOT FossilStarted THEN
  72.         PRINT "Need to Set the Port Parameters First..."
  73.      ELSE
  74.         SELECT CASE A$
  75.            CASE "1"
  76.           CALL Case1
  77.            CASE "2"
  78.           CALL Case2
  79.            CASE "3"
  80.           CALL Case3
  81.            CASE "4"
  82.           CALL Case4
  83.            CASE "5"
  84.           CALL Case5
  85.            CASE "6"
  86.           CALL Case6
  87.            CASE "7"
  88.           CALL Case7
  89.            CASE "8"
  90.           CALL Case8
  91.            CASE "9"
  92.           CALL Case9
  93.            CASE "A"
  94.           CALL CaseA
  95.            CASE "B"
  96.           CALL CaseB
  97.            CASE "C"
  98.           CALL CaseC
  99.            CASE "D"
  100.           CALL CaseD
  101.            CASE "E"
  102.           CALL CaseE
  103.            CASE "F"
  104.           CALL CaseF
  105.            CASE "G"
  106.           CALL CaseG
  107.         END SELECT
  108.      END IF
  109.  
  110.       LOOP WHILE A$ <> "Q"
  111.  
  112.       X = FossilDeactivate(ComPort%)
  113.       CALL Delay(1)
  114.       END
  115.  
  116. '*  Case1()
  117. '*---------------------------------------------------------------------------
  118. '*
  119. '*
  120.       SUB Case1
  121.       SHARED ComPort%, BaudRate&, FossilStarted
  122.       PRINT "Port Number (0 for COM1): ";
  123.       LINE INPUT B$
  124.       ComPort% = VAL(B$)
  125.       PRINT "Baud Rate (300,1200,...19200,38400): ";
  126.       LINE INPUT B$
  127.       BaudRate& = VAL(B$)
  128.       PRINT
  129.       X = FossilDeactivate(ComPort%)
  130.       X = FossilInit(ComPort%)
  131.       IF X <> 0 THEN
  132.      PRINT "Bad Port Parameters or No FOSSIL Loaded..."
  133.       ELSE
  134.      X = FossilSetBaud(ComPort%, BaudRate&)
  135.      X = FossilFlowControl(ComPort%, NoFlow)
  136.      FossilStarted = TRUE
  137.      PRINT "FOSSIL Initialized..."
  138.       END IF
  139.       END SUB
  140.  
  141. '*  Case2()
  142. '*---------------------------------------------------------------------------
  143. '*
  144. '*
  145.       SUB Case2
  146.       SHARED ComPort%, CrLf$
  147.       PRINT "Sending Data... Press ESC to Abort";
  148.       DO
  149.      A$ = "Sending Data with FossilPutchWait()" + CrLf$
  150.      FOR I = 1 TO 20
  151.         FOR J = 1 TO LEN(A$)
  152.            B$ = MID$(A$, J, 1)
  153.            X = FossilPutchWait(ComPort%, B$)
  154.         NEXT
  155.      NEXT
  156.       LOOP WHILE INKEY$ <> CHR$(27)
  157.       PRINT
  158.       END SUB
  159.  
  160. '*  Case3()
  161. '*---------------------------------------------------------------------------
  162. '*
  163. '*
  164.       SUB Case3
  165.       SHARED ComPort%, CrLf$
  166.       PRINT "Sending Data... Press ESC to Abort";
  167.       DO
  168.      A$ = "Sending Data with FossilPutch()" + CrLf$
  169.      FOR I = 1 TO 20
  170.         FOR J = 1 TO LEN(A$)
  171.            B$ = MID$(A$, J, 1)
  172.            DO
  173.           X = FossilStatus(ComPort%)
  174.            LOOP WHILE (X AND THRE) <> THRE
  175.            X = FossilPutch(ComPort%, B$)
  176.         NEXT
  177.      NEXT
  178.       LOOP WHILE INKEY$ <> CHR$(27)
  179.       PRINT
  180.       END SUB
  181.  
  182. '*  Case4()
  183. '*---------------------------------------------------------------------------
  184. '*
  185. '*
  186.       SUB Case4
  187.       SHARED ComPort%, CrLf$
  188.       PRINT "Sending Data... Press ESC to Abort";
  189.       DO
  190.      A$ = "Sending Data with FossilPutb()" + CrLf$
  191.      FOR I = 1 TO 20
  192.         CharsSent = 0
  193.         CharsToSend = LEN(A$)
  194.         DO
  195.            X = FossilPutb(ComPort%, MID$(A$, CharsSent + 1))
  196.            CharsSent = CharsSent + X
  197.         LOOP WHILE CharsSent < CharsToSend
  198.      NEXT
  199.       LOOP WHILE INKEY$ <> CHR$(27)
  200.       PRINT
  201.       END SUB
  202.  
  203. '*  Case5()
  204. '*---------------------------------------------------------------------------
  205. '*
  206. '*
  207.       SUB Case5
  208.       SHARED ComPort%
  209.       PRINT "Receiving Data... Press ESC to Abort"
  210.       DO
  211.      X = FossilStatus(ComPort%)
  212.      IF (X AND RDA) = RDA THEN
  213.         A$ = FossilGetch$(ComPort%)
  214.         PRINT A$;
  215.      END IF
  216.       LOOP WHILE INKEY$ <> CHR$(27)
  217.       PRINT
  218.       END SUB
  219.  
  220. '*  Case6()
  221. '*---------------------------------------------------------------------------
  222. '*
  223. '*
  224.       SUB Case6
  225.       SHARED ComPort%
  226.       PRINT "Receiving Data... Press ESC to Abort"
  227.       DO
  228.      A$ = SPACE$(32)
  229.      X = FossilGetb(ComPort%, A$, 32)
  230.      IF X > 0 THEN
  231.         A$ = LEFT$(A$, X)
  232.         PRINT A$;
  233.      END IF
  234.       LOOP WHILE INKEY$ <> CHR$(27)
  235.       PRINT
  236.       END SUB
  237.  
  238. '*  Case7()
  239. '*---------------------------------------------------------------------------
  240. '*
  241. '*
  242.       SUB Case7
  243.       SHARED ComPort%
  244.       PRINT "Waiting for a Character... (Press ESC to Abort)"
  245.       DO
  246.      A$ = FossilPeek(ComPort%)
  247.      IF A$ <> "" THEN
  248.         PRINT "There's a '"; A$; "' in the Buffer.  Use FossilGetch() to Prove It."
  249.         EXIT DO
  250.      END IF
  251.       LOOP WHILE INKEY$ <> CHR$(27)
  252.       END SUB
  253.  
  254. '*  Case8()
  255. '*---------------------------------------------------------------------------
  256. '*
  257. '*
  258.       SUB Case8
  259.       SHARED ComPort%
  260.       PRINT "S)et or R)eset DTR: ";
  261.       DO
  262.      A$ = INKEY$
  263.      A$ = UCASE$(A$)
  264.      IF A$ = "S" THEN
  265.         X = FossilDTR(ComPort%, 1)
  266.         EXIT DO
  267.      ELSEIF A$ = "R" THEN
  268.         X = FossilDTR(ComPort%, 1)
  269.         EXIT DO
  270.      END IF
  271.       LOOP WHILE A$ <> "S" AND A$ <> "R"
  272.       PRINT A$
  273.       END SUB
  274.  
  275. '*  Case9()
  276. '*---------------------------------------------------------------------------
  277. '*
  278. '*
  279.       SUB Case9
  280.  
  281.       SHARED ComPort%
  282.  
  283.       X = FossilInfo%(ComPort%, Ver%, Rev%, ID$, ISZ%, IFR%, OSZ%, OFR%, SW%, SH%, Baud&)
  284.  
  285.       PRINT "FOSSIL ID     : "; ID$
  286.       PRINT "FOSSIL Rev/Ver:"; Rev%; "("; Ver%; ")"
  287.       PRINT "Speed         :"; Baud&; "baud"
  288.       PRINT "Input Buffer  : Size"; ISZ%; "bytes   Free"; IFR%; "bytes"
  289.       PRINT "Output Buffer : Size"; OSZ%; "bytes   Free"; OFR%; "bytes"
  290.       PRINT "Screen        :"; SW%; "X"; SH%
  291.       PRINT
  292.       PRINT "Press a Key..."
  293.  
  294.       DO
  295.      A$ = INKEY$
  296.       LOOP WHILE A$ = ""
  297.  
  298.       END SUB
  299.  
  300. '*  CaseA()
  301. '*---------------------------------------------------------------------------
  302. '*
  303. '*
  304.       SUB CaseA
  305.       PRINT "Press a Key...";
  306.       DO
  307.      X = FossilInkey
  308.       LOOP WHILE X = -1
  309.       A$ = INKEY$
  310.       PRINT
  311.       PRINT "The Key You Pressed Has a Scan Code of"; X
  312.       END SUB
  313.  
  314. '*  CaseB()
  315. '*---------------------------------------------------------------------------
  316. '*
  317. '*
  318.       SUB CaseB
  319.       PRINT "Press a Key...";
  320.       X = FossilInkeyWait
  321.       PRINT
  322.       PRINT "The Key You Pressed Has a Scan Code of"; X
  323.       END SUB
  324.  
  325. '*  CaseC()
  326. '*---------------------------------------------------------------------------
  327. '*
  328. '*
  329.       SUB CaseC
  330.       X = FossilReadCursor(Row%, Column%)
  331.       PRINT "The Cursor is at Row"; Row%; " Column"; Column%; "..."
  332.       END SUB
  333.  
  334. '*  CaseD()
  335. '*---------------------------------------------------------------------------
  336. '*
  337. '*
  338.       SUB CaseD
  339.       PRINT "Move to Row: ";
  340.       LINE INPUT A$
  341.       Row% = VAL(A$)
  342.       PRINT "Move to Column: ";
  343.       LINE INPUT A$
  344.       Column% = VAL(A$)
  345.       IF Row% < 0 OR Column% < 0 THEN
  346.      EXIT SUB
  347.       END IF
  348.       X = FossilLocate(Row%, Column%)
  349.       X = FossilBIOSPrint("<--*** The Cursor Moved to Here. ***  Press a Key...   ")
  350.       DO
  351.      A$ = INKEY$
  352.       LOOP WHILE A$ = ""
  353.       END SUB
  354.  
  355. '*  CaseE()
  356. '*---------------------------------------------------------------------------
  357. '*
  358. '*
  359.       SUB CaseE
  360.       X = FossilAnsiPrint("This is ANSI????")
  361.       PRINT
  362.       END SUB
  363.  
  364. '*  CaseF()
  365. '*---------------------------------------------------------------------------
  366. '*
  367. '*
  368.       SUB CaseF
  369.       X = FossilBIOSPrint("Print Using the BIOS?  Why???")
  370.       PRINT
  371.       END SUB
  372.  
  373. '*  CaseG()
  374. '*---------------------------------------------------------------------------
  375. '*
  376. '*
  377.       SUB CaseG
  378.       PRINT "Do a W)arm Boot, C)old Boot or N)either? ";
  379.       DO
  380.          A$ = INKEY$
  381.          A$ = UCASE$(A$)
  382.      IF A$ = "W" THEN
  383.         X = FossilReboot(1)
  384.      ELSEIF A$ = "C" THEN
  385.         X = FossilReboot(0)
  386.      ELSEIF A$ = "N" THEN
  387.         EXIT DO
  388.      END IF
  389.       LOOP WHILE 1
  390.       PRINT A$
  391.       END SUB
  392.  
  393. '*  ConvertTime()
  394. '*---------------------------------------------------------------------------
  395. '*
  396. '*  Routine to convert from QB's TIME$ function to an absolute # of seconds
  397. '*  within a day.
  398. '*
  399.       FUNCTION ConvertTime& (T$)
  400.       Hours = VAL(T$)
  401.       Mins = VAL(MID$(T$, 4))
  402.       Secs = VAL(MID$(T$, 7))
  403.       ConvertTime& = Hours * 3600 + Mins * 60 + Secs
  404.       END FUNCTION
  405.  
  406. '*  Delay()
  407. '*---------------------------------------------------------------------------
  408. '*
  409. '*  Routine to delay a certain number of seconds.
  410. '*
  411.       SUB Delay (DelaySecs&)
  412.       StartSecs& = ConvertTime(TIME$)
  413.       DO
  414.      EndSecs& = ConvertTime(TIME$)
  415.       LOOP WHILE EndSecs& >= StartSecs& AND EndSecs& < StartSecs& + DelaySecs&
  416.       END SUB
  417.  
  418.