home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 15 / CD_ASCQ_15_070894.iso / vrac / svgapb21.zip / SVGADEMO.BAS < prev    next >
BASIC Source File  |  1994-05-09  |  24KB  |  718 lines
  1. '****************************************************************************
  2. '*
  3. '*      'SVGAPB' A Super VGA Graphics Librarys for use with 
  4. '*      Spectra Publishing's Power BASIC 3.x
  5. '*      Copyright 1993-1994 by Stephen L. Balkum and Daniel A. Sill
  6. '*
  7. '*      Power BASIC is a registered trademark of Spectra Publishing.
  8. '*      GIF and 'Graphics Interchange Format' are trademarks (TM) 
  9. '*      ofCompuServe, Incorporated, an H&R Block Company.
  10. '*
  11. '*    **************** UNREGISTERED SHAREWARE VERSION **********************
  12. '*    * FOR EVALUATION ONLY. NOT FOR RESALE IN ANY FORM. SOFTWARE WRITTEN  *
  13. '*    * USING THIS UNREGISTERED SHAREWARE GRAPHICS LIBRARY MAY NOT BY SOLD *
  14. '*    * OR USED FOR ANY PURPOSE OTHER THAN THE EVALUATION OF THIS LIBRARY. *
  15. '*    **********************************************************************
  16. '*
  17. '*    **************** NO WARRANTIES AND NO LIABILITY **********************
  18. '*    * Stephen L. Balkum and Daniel A. Sill provide no warranties, either *
  19. '*    * expressed or implied, of merchant ability, or fitness, for a       *
  20. '*    * particular use or purpose of this SOFTWARE and documentation.      *
  21. '*    * In no event shall Stephen L. Balkum or Daniel A. Sill be held      *
  22. '*    * liable for any damages resulting from the use or misuse of the     *
  23. '*    * SOFTWARE and documentation.                                        *
  24. '*    **********************************************************************
  25. '*
  26. '*    ************** U.S. GOVERNMENT RESTRICTED RIGHTS *********************
  27. '*    * Use, duplication, or disclosure of the SOFTWARE and documentation  *
  28. '*    * by the U.S. Government is subject to the restrictions as set forth *
  29. '*    * in subparagraph (c)(1)(ii) of the Rights in Technical Data and     *
  30. '*    * Computer Software clause at DFARS 252.227-7013.                    *
  31. '*    * Contractor/manufacturer is Stephen L. Balkum and Daniel A. Sill,   *
  32. '*    * P.O. Box 7704, Austin, Texas 78713-7704                            *
  33. '*    **********************************************************************
  34. '*
  35. '*    **********************************************************************
  36. '*    * By using this SOFTWARE or documentation, you agree to the above    *
  37. '*    * terms and conditions.                                              *
  38. '*    **********************************************************************
  39. '*
  40. '****************************************************************************
  41.  
  42.  
  43.     $LINK "SVGAPB.PBL"
  44.     $INCLUDE "SVGAPB.BI"
  45.  
  46.     DEFINT A-Z
  47.  
  48.     DIM POINTARRY3D(13) AS SHARED P3Dtype
  49.     DIM PLAYARRY(13) AS SHARED P3Dtype
  50.     DIM PLOTARRY(13) AS SHARED P2DType
  51.     DIM OPLOTARRY(13) AS SHARED P2DType
  52.     DIM DYNAMIC GFXBLK1(10000) AS SHARED INTEGER
  53.     DIM DYNAMIC GFXBLK2(32000) AS SHARED INTEGER
  54.     DIM DYNAMIC GFXBLK3(32000) AS SHARED INTEGER
  55.     DIM MAGMOUSECURSOR(386) AS SHARED BYTE
  56.     DIM BIGMOUSECURSOR(386) AS SHARED BYTE
  57.     DIM STWMOUSECURSOR(386) AS SHARED BYTE
  58.     DIM PAL(255) AS SHARED RGBType
  59.     DIM PAL2(255) AS SHARED RGBType
  60.     DIM ORGPAL(255) AS SHARED RGBType
  61.     DIM GIFPAL(255) AS SHARED RGBType
  62.     
  63.     $INCLUDE "SVGADEMO.BI"
  64.     $INCLUDE "SVGAMOD1.BAS"
  65.     $INCLUDE "SVGAMOD2.BAS"
  66.     
  67.  
  68.     '*************************************************************************
  69.     '* SAVE THE STARTING VIDEOMODE AND SET IT TO MODE 3.
  70.     '*************************************************************************
  71.     STARTVIDEOMODE = VIDEOMODEGET
  72.     DUMMY = RESTEXT
  73.     CLS
  74.     FOR A = 0 TO 33
  75.         DUMMY$ = INKEY$  '* CLEAR THE KEYBOARD BUFFER
  76.     NEXT A
  77.  
  78.     '*************************************************************************
  79.     '* MOVE THE DOS CURSOR TO THE TOP LEFT TO START THE PROGRAM AND SAY HELLO
  80.     '*************************************************************************
  81.     LOCATE 1, 15
  82.     PRINT "'SVGAPB' A Super VGA Graphics Librarys for use with"
  83.  
  84.     LOCATE 2, 23
  85.     PRINT "Spectra Publishing's Power BASIC 3.x"
  86.  
  87.     LOCATE 4, 10
  88.     PRINT "Copyright 1993-1994 by Stephen L. Balkum and Daniel A. Sill"
  89.     LOCATE 12, 25
  90.     PRINT "Demonstration/Example Program"
  91.     LOCATE 23, 1
  92.     PRINT "Press a key to begin the demo..."
  93.     GETKEY (RET$)
  94.     CLS
  95.  
  96.     '*************************************************************************
  97.     '* LET'S ID THE PROCESSOR FIRST AS THE LIBRARY REQUIRES A 386 OR BETTER.
  98.     '*************************************************************************
  99.     'LOCATE 1, 1
  100.     CPU = WHICHCPU
  101.     CPU$ = STR$(CPU)
  102.     L = LEN(CPU$)
  103.     CPU$ = RIGHT$(CPU$, L - 1)
  104.     IF CPU < 386 THEN
  105.         PRINT "Sorry, this library requires a 80386 or better processor."
  106.         PRINT "Processor is identified as a 80"; CPU$; "."
  107.         PRINT "Demo program will be terminated."
  108.         PRINT
  109.         PRINT "Press a key..."
  110.         SOUND 100, 5
  111.         WHILE INKEY$ = ""
  112.         WEND
  113.         VIDEOMODESET STARTVIDEOMODE
  114.     END
  115.     END IF
  116.  
  117.     '*************************************************************************
  118.     '* LET'S ID THE VIDEO CARD/CHIP AS THE LIBRARY REQUIRES A SUPERVGA ADAPTER.
  119.     '*************************************************************************
  120.     VGA = WHICHVGA
  121.     PRINT "Microprocessor is identified as a 80"; CPU$; "."
  122.     PRINT
  123.     SELECT CASE VGA
  124.         CASE = 1
  125.             VGA$ = "Acumos AVGA2/3 SuperVGA"
  126.         CASE = 2
  127.             VGA$ = "ATI Technologies 18/28/38/68800 SuperVGA"
  128.         CASE = 3
  129.             VGA$ = "Ahead V5000 ver A SuperVGA"
  130.         CASE = 4
  131.             VGA$ = "Ahead V5000 ver B SuperVGA"
  132.         CASE = 5
  133.             VGA$ = "Chips and Technologies 82C450/1/2/3/5/6/7 SuperVGA"
  134.         CASE = 6
  135.             VGA$ = "Cirrus Logic CL-GD 5xx,6xx,28xx,54xx,62xx SuperVGA"
  136.         CASE = 7
  137.             VGA$ = "Everex Ev236/6xx Micro Enhancer SuperVGA"
  138.         CASE = 8
  139.             VGA$ = "Genoa 61/62/63/64/6600 SuperVGA"
  140.         CASE = 9
  141.             VGA$ = "NCR 77C21/22/22E/22E+ SuperVGA"
  142.         CASE = 10
  143.             VGA$ = "Oak Technologies OTI-037C/067/077/087 SuperVGA"
  144.         CASE = 11
  145.             VGA$ = "Paradise/Western Digital PVGA1A,WD90C00/1x/2x/3x SuperVGA"
  146.         CASE = 12
  147.             VGA$ = "Realtek RT3106 SuperVGA"
  148.         CASE = 13
  149.             VGA$ = "Trident 8800CS,8900B/C/CL/CX,90x0 SuperVGA"
  150.         CASE = 14
  151.             VGA$ = "Tseng Labs ET3000-AX/BX/BP SuperVGA"
  152.         CASE = 15
  153.             VGA$ = "Tseng Labs ET4000/W32/W32I SuperVGA"
  154.         CASE = 16
  155.             VGA$ = "VESA compatible SuperVGA"
  156.         CASE = 17
  157.             VGA$ = "Video 7 HT-208/16 SuperVGA"
  158.         CASE = 18
  159.             VGA$ = "Avance Logic AL2101 SuperVGA"
  160.         CASE = 19
  161.             VGA$ = "MXIC MX68000/10 SuperVGA"
  162.         CASE = 20
  163.             VGA$ = "Primus P2000 SuperVGA"
  164.         CASE ELSE
  165.             VGA$ = "Unknown"
  166.             VGA = 0
  167.     END SELECT
  168.     IF VGA < 1 THEN
  169.         PRINT "Sorry, unable to identify video card or it is not a SuperVGA video adapter."
  170.         PRINT "Demo program will be terminated."
  171.         PRINT
  172.         PRINT "Press a key..."
  173.         SOUND 100, 5
  174.         WHILE INKEY$ = ""
  175.         WEND
  176.         PRINT "VGA=";VGA
  177.         VIDEOMODESET STARTVIDEOMODE
  178.         END
  179.     ELSE
  180.         PRINT "Video card/chip is identified as a "; VGA$; "."
  181.     END IF
  182.  
  183.     '*************************************************************************
  184.     '* LET'S SEE THE HOW MUCH MEMORY IS INSTALLED ON THE SUPER VGA ADAPTER.
  185.     '*************************************************************************
  186.     VIDEOMEMORY = WHICHMEM
  187.     MEM$ = STR$(VIDEOMEMORY)
  188.     MEM$ = RIGHT$(MEM$, LEN(MEM$) - 1) + " kB"
  189.     IF VIDEOMEMORY < 1 THEN
  190.         PRINT "Sorry, unable to identify the amount of installed video memory."
  191.         PRINT "Demo program will be terminated."
  192.         PRINT
  193.         PRINT "Press a key..."
  194.         SOUND 100, 5
  195.         WHILE INKEY$ = ""
  196.         WEND
  197.         VIDEOMODESET STARTVIDEOMODE
  198.         END
  199.     ELSE
  200.         PRINT "Installed video memory identified as "; MEM$; "."
  201.     END IF
  202.  
  203.     '*************************************************************************
  204.     '* LET'S TELL THE USER WHAT THE HIGHEST RESOLUTION THAT THE VIDEO CARD
  205.     '* AND ITS INSTALLED MEMORY CARD IS CAPABLE OF. THE MONITOR MUST BE ABLE
  206.     '* TO SUPPORT THOSE MODES TOO !
  207.     '*************************************************************************
  208.     PRINT "Video card and installed memory is capable of the following resolutions:"
  209.     SELECT CASE VIDEOMEMORY
  210.         CASE > 2047
  211.             PRINT TAB(4); "320x200 in 256 colors"
  212.             PRINT TAB(4); "640x400 in 256 colors"
  213.             PRINT TAB(4); "640x480 in 256 colors"
  214.             PRINT TAB(4); "800x600 in 256 colors"
  215.             PRINT TAB(4); "1024x768 in 256 colors"
  216.             PRINT TAB(4); "1280x1024 in 256 colors"
  217.             MAXVAL = 5
  218.         CASE > 1023
  219.             PRINT TAB(4); "320x200 in 256 colors"
  220.             PRINT TAB(4); "640x400 in 256 colors"
  221.             PRINT TAB(4); "640x480 in 256 colors"
  222.             PRINT TAB(4); "800x600 in 256 colors"
  223.             PRINT TAB(4); "1024x768 in 256 colors"
  224.             MAXVAL = 4
  225.         CASE > 511
  226.             PRINT TAB(4); "320x200 in 256 colors"
  227.             PRINT TAB(4); "640x400 in 256 colors"
  228.             PRINT TAB(4); "640x480 in 256 colors"
  229.             PRINT TAB(4); "800x600 in 256 colors"
  230.             MAXVAL = 3
  231.         CASE ELSE
  232.             PRINT TAB(4); "320x200 in 256 colors"
  233.             PRINT TAB(4); "640x400 in 256 colors"
  234.             MAXVAL = 1
  235.     END SELECT
  236.     PRINT
  237.     PRINT "PLEASE keep in mind that not all monitors support all resolutions."
  238.     PRINT "If you know your monitor will not work properly in certain resolutions"
  239.     PRINT "(such as 1024x768 or 1280x1024), do NOT run the demo in that resolution."
  240.     PRINT
  241.  
  242.     '*************************************************************************
  243.     '* LET'S LOOK FOR A MOUSE. IF WE FIND ONE, TELL ALL ABOUT IT
  244.     '*************************************************************************
  245.     MOUSE = WHICHMOUSE
  246.     IF MOUSE > 0 THEN
  247.         MOUSEINFO MJV, MNV, TP, I
  248.         VER$ = STR$(MNV)
  249.         L = LEN(VER$)
  250.         VER$ = STR$(MJV) + "." + RIGHT$(VER$, L - 1)
  251.         VER$ = "Software driver version is" + VER$ + " (Microsoft equivalent version)."
  252.         SELECT CASE TP
  253.             CASE = 1
  254.                 MTYPE$ = "bus mouse"
  255.             CASE = 2
  256.                 MTYPE$ = "serial mouse"
  257.             CASE = 3
  258.                 MTYPE$ = "Inport mouse"
  259.             CASE = 4
  260.                 MTYPE$ = "PS/2 mouse"
  261.             CASE = 5
  262.                 MTYPE$ = "HP mouse"
  263.             CASE ELSE
  264.                 MTYPE$ = "unknown type"
  265.         END SELECT
  266.         PRINT "Microsoft compatible " + MTYPE$ + " detected with" + STR$(MOUSE) + " buttons on IRQ" + STR$(I) + "."
  267.         PRINT VER$
  268.     ELSE
  269.         PRINT "No Microsoft compatible mouse detected."
  270.     END IF
  271.     PRINT
  272.  
  273.     '*************************************************************************
  274.     '* LET'S LOOK FOR JOYSTICKS
  275.     '*************************************************************************
  276.     JOYSTICK = WHICHJOYSTICK
  277.     SELECT CASE JOYSTICK
  278.         CASE = -1
  279.             A$ = "No joystick port detected or no joystick BIOS support present."
  280.         CASE = 0
  281.             A$ = "No joystick detected."
  282.         CASE = 1
  283.             A$ = "Joystick A is present and available."
  284.         CASE = 2
  285.             A$ = "Joystick B is present and available."
  286.         CASE = 3
  287.             A$ = "Both Joystick A and Joystick B are present and available."
  288.     END SELECT
  289.     PRINT A$
  290.     PRINT
  291.     PRINT "Press a key..."
  292.     GETKEY RET$
  293.  
  294.     '*************************************************************************
  295.     '* LET'S GET DOWN TO BUSINESS!
  296.     '*************************************************************************
  297.     RES = 1
  298.     ENDIT = 0
  299.  
  300.     '*************************************************************************
  301.     '* INIT ALTERNATE MOUSE CURSORS
  302.     '*************************************************************************
  303.     FOR I = 0 TO 385
  304.         READ MAGMOUSECURSOR(I)
  305.     NEXT I
  306.     FOR I = 0 TO 385
  307.         READ BIGMOUSECURSOR(I)
  308.     NEXT I
  309.     FOR I = 0 TO 385
  310.         READ STWMOUSECURSOR(I)
  311.     NEXT I
  312.  
  313.     '*************************************************************************
  314.     '* INIT ALTERNATE COLOR PALETTES
  315.     '*************************************************************************
  316.     DUMMY = RES320
  317.     PALGET ORGPAL(0), 0, 255
  318.     PALCOPY ORGPAL(0), PAL(0), 0, 255
  319.     PALCOPY ORGPAL(0), PAL2(0), 0, 255
  320.     MYPI! = 8 * ATN(1) / 240
  321.     FOR Colr = 0 TO 239
  322.         R1 = 32 + SIN((Colr + 0) * MYPI!) * 31
  323.         G1 = 32 + SIN((Colr + 80) * MYPI!) * 31
  324.         B1 = 32 + SIN((Colr + 160) * MYPI!) * 31
  325.         R2 = 32 + SIN((Colr + 10) * MYPI!) * 31
  326.         G2 = 32 + SIN((Colr + 30) * MYPI!) * 31
  327.         B2 = 32 + SIN((Colr + 50) * MYPI!) * 31
  328.         OFFSET = Colr + 16
  329.         PAL(OFFSET).R = R1  '* RED
  330.         PAL(OFFSET).G = G1  '* GREEN
  331.         PAL(OFFSET).B = B1  '* BLUE
  332.         PAL2(OFFSET).R = R2  '* RED
  333.         PAL2(OFFSET).G = G2  '* GREEN
  334.         PAL2(OFFSET).B = B2  '* BLUE
  335.     NEXT Colr
  336.     DUMMY = RESTEXT
  337.  
  338.     '*************************************************************************
  339.     '* HERE IS THE MAIN SELECTOR LOOP
  340.     '*************************************************************************
  341.     WHILE ENDIT = 0
  342.         RetVal$ = ""
  343.         CLS
  344.         SOUND 700, .75
  345.         SELECT CASE RES
  346.             CASE = 1
  347.                 RES$ = "320x200x256"
  348.             CASE = 2
  349.                 RES$ = "640x400x256"
  350.             CASE = 3
  351.                 RES$ = "640x480x256"
  352.             CASE = 4
  353.                 RES$ = "800x600x256"
  354.             CASE = 5
  355.                 RES$ = "1024x768x256"
  356.             CASE = 6
  357.                 RES$ = "1280x1024x256"
  358.         END SELECT
  359.         PRINT "Please select the demo you would like to see in the " + RES$ + " resolution:"
  360.         PRINT
  361.         PRINT "(0)  Exit This Program"
  362.         PRINT
  363.         PRINT "(1)  Demo #1  The Primitive Drawing Routines"
  364.         PRINT "(2)  Demo #2  The Clipping Capabilities"
  365.         PRINT "(3)  Demo #3  The Fill Routines"
  366.         PRINT "(4)  Demo #4  The Palette Routines"
  367.         PRINT "(5)  Demo #5  The Block Routines"
  368.         PRINT "(6)  Demo #6  The Text Routines"
  369.         PRINT "(7)  Demo #7  The Scrolling Routines"
  370.         PRINT "(8)  Demo #8  The GIF (TM) Routines"
  371.         PRINT "(9)  Demo #9  The Mouse Routines"
  372.         PRINT "(10) Demo #10 The Joystick Routines"
  373.         PRINT "(11) Demo #11 The Two Dimensional Routines"
  374.         PRINT "(12) Demo #12 The Three Dimensional Routines"
  375.         PRINT "(13) The Grand Tour Of All Demos"
  376.         SELECT CASE VIDEOMEMORY
  377.             CASE > 2047
  378.                 PRINT "(14) Use 320x200x256  Resolution"
  379.                 PRINT "(15) Use 640x400x256  Resolution"
  380.                 PRINT "(16) Use 640x480x256  Resolution"
  381.                 PRINT "(17) Use 800x600x256  Resolution"
  382.                 PRINT "(18) Use 1024x768x256 Resolution"
  383.                 PRINT "(19) Use 1280x1024x256 Resolution"
  384.                 MAXVAL = 19
  385.             CASE > 1023
  386.                 PRINT "(14) Use 320x200x256  Resolution"
  387.                 PRINT "(15) Use 640x400x256  Resolution"
  388.                 PRINT "(16) Use 640x480x256  Resolution"
  389.                 PRINT "(17) Use 800x600x256  Resolution"
  390.                 PRINT "(18) Use 1024x768x256 Resolution"
  391.                 MAXVAL = 18
  392.             CASE > 511
  393.                 PRINT "(14) Use 320x200x256  Resolution"
  394.                 PRINT "(15) Use 640x400x256  Resolution"
  395.                 PRINT "(16) Use 640x480x256  Resolution"
  396.                 PRINT "(17) Use 800x600x256  Resolution"
  397.                 MAXVAL = 17
  398.             CASE ELSE
  399.                 PRINT "(14) Use 320x200x256  Resolution"
  400.                 PRINT "(15) Use 640x400x256  Resolution"
  401.                 MAXVAL = 15
  402.         END SELECT
  403.         A$ = ""
  404.         INPUT "Your Choice"; A$
  405.         KY = VAL(A$)
  406.         IF (A$ > "9") OR (A$ < "0") THEN
  407.             KY = -1
  408.         END IF
  409.         IF KY > MAXVAL THEN
  410.             KY = -1
  411.         END IF
  412.         IF KY > 0 AND KY < 13 THEN
  413.             SELECT CASE RES
  414.                 CASE = 1
  415.                     OK = RES320
  416.                 CASE = 2
  417.                     OK = RES640L
  418.                 CASE = 3
  419.                     OK = RES640
  420.                 CASE = 4
  421.                     OK = RES800
  422.                 CASE = 5
  423.                     OK = RES1024
  424.                 CASE = 6
  425.                     OK = RES1280
  426.             END SELECT
  427.             IF OK <> 1 THEN
  428.                 DUMMY = RESTEXT
  429.                 CLS
  430.                 SOUND 100, 5
  431.                 PRINT "Sorry, although your video card has enough memeory, it does"
  432.                 PRINT "not support this video mode. PRESS A KEY."
  433.                 GETKEY RET$
  434.                 KY = -1
  435.             END IF
  436.         END IF
  437.         SELECT CASE KY
  438.             CASE = 0
  439.                 ENDIT = 1
  440.             CASE = 1
  441.                 'DEMO #1
  442.                 DOPRIMS RetVal$
  443.                 DUMMY = RESTEXT
  444.             CASE = 2
  445.                 'DEMO #2
  446.                 DOCLIP RetVal$
  447.                 DUMMY = RESTEXT
  448.             CASE = 3
  449.                 'DEMO #3
  450.                 DOFILL RetVal$
  451.                 DUMMY = RESTEXT
  452.             CASE = 4
  453.                 'DEMO #4
  454.                 DOPAL RetVal$
  455.                 DUMMY = RESTEXT
  456.             CASE = 5
  457.                 'DEMO #5
  458.                 DOBLOCK RetVal$
  459.                 DUMMY = RESTEXT
  460.             CASE = 6
  461.                 'DEMO #6
  462.                 DOTEXT RetVal$
  463.                 DUMMY = RESTEXT
  464.             CASE = 7
  465.                 'DEMO #7
  466.                 DOSCROLL RetVal$
  467.                 DUMMY = RESTEXT
  468.             CASE = 8
  469.                 'DEMO #8
  470.                 DOGIF RetVal$
  471.                 DUMMY = RESTEXT
  472.             CASE = 9
  473.                 'DEMO #9
  474.                 DOMOUSE RetVal$
  475.                 DUMMY = RESTEXT
  476.             CASE = 10
  477.                 'DEMO #10
  478.                 DOJOYSTICK RetVal$
  479.                 DUMMY = RESTEXT
  480.             CASE = 11
  481.                 'DEMO #11
  482.                 DO2D RetVal$
  483.                 DUMMY = RESTEXT
  484.             CASE = 12
  485.                 'DEMO #12
  486.                 DO3D RetVal$
  487.                 DUMMY = RESTEXT
  488.             CASE = 13
  489.                 'DO THE GRAND TOUR OF ALL DEMOS!
  490.                 CLS
  491.                 PRINT "Press 'Q' To End Grand Tour At Any Time. Press 'S' To Skip To The Next"
  492.                 PRINT "Demo At Any Time. Press Any Other Key to Begin The Grand Tour..."
  493.                 GETKEY RET$
  494.                 IF RET$ = "Q" THEN
  495.                     GOTO EXITGRANDTOUR
  496.                 END IF
  497.  
  498.                 SELECT CASE RES
  499.                     CASE = 1
  500.                         OK = RES320
  501.                     CASE = 2
  502.                         OK = RES640L
  503.                     CASE = 3
  504.                         OK = RES640
  505.                     CASE = 4
  506.                         OK = RES800
  507.                     CASE = 5
  508.                         OK = RES1024
  509.                     CASE = 6
  510.                         OK = RES1280
  511.                 END SELECT
  512.                 IF OK <> 1 THEN
  513.                     DUMMY = RESTEXT
  514.                     CLS
  515.                     SOUND 100, 5
  516.                     PRINT "Sorry, although your video card has enough memeory, it does"
  517.                     PRINT "not support this video mode. PRESS A KEY."
  518.                     GETKEY RET$
  519.                     GOTO EXITGRANDTOUR
  520.                 END IF
  521.                 'DEMO #1
  522.                 DOPRIMS RetVal$
  523.                 IF RetVal$ = "Q" THEN
  524.                     GOTO EXITGRANDTOUR
  525.                 END IF
  526.                 'DEMO #2
  527.                 DOCLIP RetVal$
  528.                 IF RetVal$ = "Q" THEN
  529.                     GOTO EXITGRANDTOUR
  530.                 END IF
  531.                 'DEMO #3
  532.                 DOFILL RetVal$
  533.                 IF RetVal$ = "Q" THEN
  534.                     GOTO EXITGRANDTOUR
  535.                 END IF
  536.                 'DEMO #4
  537.                 DOPAL RetVal$
  538.                 IF RetVal$ = "Q" THEN
  539.                     GOTO EXITGRANDTOUR
  540.                 END IF
  541.                 'DEMO #5
  542.                 DOBLOCK RetVal$
  543.                 IF RetVal$ = "Q" THEN
  544.                     GOTO EXITGRANDTOUR
  545.                 END IF
  546.                 'DEMO #6
  547.                 DOTEXT RetVal$
  548.                 IF RetVal$ = "Q" THEN
  549.                     GOTO EXITGRANDTOUR
  550.                 END IF
  551.                 'DEMO #7
  552.                 DOSCROLL RetVal$
  553.                 IF RetVal$ = "Q" THEN
  554.                     GOTO EXITGRANDTOUR
  555.                 END IF
  556.                 'DEMO #8
  557.                 DOGIF RetVal$
  558.                 IF RetVal$ = "Q" THEN
  559.                     GOTO EXITGRANDTOUR
  560.                 END IF
  561.                 'DEMO #9
  562.                 DOMOUSE RetVal$
  563.                 IF RetVal$ = "Q" THEN
  564.                     GOTO EXITGRANDTOUR
  565.                 END IF
  566.                 'DEMO #10
  567.                 DOJOYSTICK RetVal$
  568.                 IF RetVal$ = "Q" THEN
  569.                     GOTO EXITGRANDTOUR
  570.                 END IF
  571.                 'DEMO #11
  572.                 DO2D RetVal$
  573.                 IF RetVal$ = "Q" THEN
  574.                     GOTO EXITGRANDTOUR
  575.                 END IF
  576.                 'DEMO #12
  577.                 DO3D RetVal$
  578. EXITGRANDTOUR:
  579.                 RetVal$ = ""
  580.                 DUMMY = RESTEXT
  581.             CASE = 14
  582.                 RES = 1
  583.             CASE = 15
  584.                 RES = 2
  585.             CASE = 16
  586.                 RES = 3
  587.             CASE = 17
  588.                 RES = 4
  589.             CASE = 18
  590.                 RES = 5
  591.             CASE = 19
  592.                 RES = 6
  593.             CASE ELSE
  594.                 SOUND 100, 5
  595.         END SELECT
  596.         IF RetVal$ = "Q" THEN
  597.             ENDIT = 1
  598.         END IF
  599.     WEND
  600.  
  601.     '*************************************************************************
  602.     '* THAT'S ALL FOLKS! END THE PROGRAM
  603.     '*************************************************************************
  604.     DUMMY = RESTEXT '* FORCE THE VGA PALETTE TO RESET
  605.     VIDEOMODESET STARTVIDEOMODE '*RESTORE THE VIDEOMODE WE STARTED IN
  606.     DUMMY = RESTEXT '* FORCE THE VGA PALETTE TO RESET
  607.     CLEAR
  608.     END
  609.  
  610.  
  611.     '*************************************************************************
  612.     '* DATA DATA DATA DATA DATA DATA DATA DATA DATA DATA DATA DATA DATA DATA
  613.     '*************************************************************************
  614.  
  615.     REM *MAGNIFIER MOUSE CURSOR DATA
  616.     DATA 7,6
  617.     DATA 255,255,255,255,255,7  ,7  ,7  ,7  ,255,255,255,255,255,255,255
  618.     DATA 255,255,255,  7,  7,255,255,255,255,7  ,7,  255,255,255,255,255
  619.     DATA 255,255,7  ,255,255,255,255,255,255,255,255,7  ,255,255,255,255
  620.     DATA 255,7  ,255,255,255,255,255,255,255,255,255,255,7  ,255,255,255
  621.     DATA 255,7  ,255,255,255,255,255,255,255,255,255,255,7  ,255,255,255
  622.     DATA 7  ,255,255,255,255,255,255,255,255,255,255,255,255,7  ,255,255
  623.     DATA 7  ,255,255,255,255,255,255,255,255,255,255,255,255,7  ,255,255
  624.     DATA 7  ,255,255,255,255,255,255,255,255,255,255,255,255,7  ,255,255
  625.     DATA 7  ,255,255,255,255,255,255,255,255,255,255,255,255,7  ,255,255
  626.     DATA 255,7  ,255,255,255,255,255,255,255,255,255,255,7  ,255,255,255
  627.     DATA 255,7  ,255,255,255,255,255,255,255,255,255,255,7  ,255,255,255
  628.     DATA 255,7  ,7  ,255,255,255,255,255,255,255,255,7  ,7  ,255,255,255
  629.     DATA 255,255,7  ,7  ,7  ,255,255,255,255,7  ,7  ,7  ,255,255,255,255
  630.     DATA 255,255,255,7  ,7  ,7  ,7  ,7  ,7  ,8  ,8  ,255,255,255,255,255
  631.     DATA 255,255,255,255,255,7  ,7  ,7  ,7  ,7  ,8  ,8  ,255,255,255,255
  632.     DATA 255,255,255,255,255,255,255,255,255,7  ,8  ,8  ,255,255,255,255
  633.     DATA 255,255,255,255,255,255,255,255,255,255,7  ,8  ,8  ,255,255,255
  634.     DATA 255,255,255,255,255,255,255,255,255,255,7  ,8  ,8  ,255,255,255
  635.     DATA 255,255,255,255,255,255,255,255,255,255,255,7  ,8  ,8  ,255,255
  636.     DATA 255,255,255,255,255,255,255,255,255,255,255,7  ,8  ,8  ,255,255
  637.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,7  ,8  ,8  ,255
  638.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,7  ,8  ,8  ,255
  639.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,7  ,8  ,8
  640.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,7  ,7  ,7
  641.  
  642.     REM *BIG ARROW MOUSE CURSOR DATA
  643.     DATA 1,1
  644.     DATA 0  ,0  ,0  ,255,255,255,255,255,255,255,255,255,255,255,255,255
  645.     DATA 0  ,15 ,15 ,0  ,0  ,255,255,255,255,255,255,255,255,255,255,255
  646.     DATA 0  ,15 ,15 ,15 ,15 ,0  ,0  ,0  ,255,255,255,255,255,255,255,255
  647.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,0  ,255,255,255,255,255,255
  648.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,0  ,0  ,255,255,255
  649.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,0  ,255
  650.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,255
  651.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,0  ,255,255
  652.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,255,255,255,255
  653.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,0  ,255,255,255,255,255
  654.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,15 ,0  ,255,255,255,255,255,255
  655.     DATA 0  ,15 ,15 ,15 ,15 ,15 ,0  ,15 ,15 ,15 ,0  ,255,255,255,255,255
  656.     DATA 0  ,15 ,15 ,15 ,15 ,0  ,0  ,15 ,15 ,15 ,0  ,255,255,255,255,255
  657.     DATA 0  ,15 ,15 ,0  ,0  ,255,255,0  ,15 ,15 ,15 ,0  ,255,255,255,255
  658.     DATA 0  ,15 ,0  ,255,255,255,255,0  ,15 ,15 ,15 ,0  ,255,255,255,255
  659.     DATA 0  ,0  ,255,255,255,255,255,255,0  ,15 ,15 ,15 ,0  ,255,255,255
  660.     DATA 255,255,255,255,255,255,255,255,255,0  ,15 ,15 ,15 ,0  ,255,255
  661.     DATA 255,255,255,255,255,255,255,255,255,0  ,15 ,15 ,15 ,0  ,255,255
  662.     DATA 255,255,255,255,255,255,255,255,255,255,0  ,15 ,15 ,15 ,0  ,255
  663.     DATA 255,255,255,255,255,255,255,255,255,255,255,0  ,15 ,15 ,15 ,0
  664.     DATA 255,255,255,255,255,255,255,255,255,255,255,0, 15  ,15 ,15 ,0
  665.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,0  ,15 ,15 ,0
  666.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,0  ,0  ,0
  667.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
  668.  
  669.     REM *STOPWATCH MOUSE CURSOR DATA
  670.     DATA 8,11
  671.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
  672.     DATA 255,255,255,255,255,255,15 ,15 ,15 ,15 ,255,255,255,255,255,255
  673.     DATA 255,255,255,255,255,255,15 ,15 ,15 ,15 ,255,255,255,255,255,255
  674.     DATA 255,255,255,255,255,255,255,15 ,15 ,255,255,255,255,255,255,255
  675.     DATA 255,255,255,255,255,255,15 ,15 ,15 ,15 ,255,255,255,255,255,255
  676.     DATA 255,255,255,255,15 ,15 ,15 ,7  ,7  ,15 ,15 ,15 ,255,255,255,255
  677.     DATA 255,255,255,15 ,15 ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,15 ,255,255,255
  678.     DATA 255,255,15 ,15 ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,15 ,255,255
  679.     DATA 255,15 ,15 ,7  ,0  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,15 ,255
  680.     DATA 255,15 ,7  ,7  ,7  ,0  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,255
  681.     DATA 15 ,15 ,7  ,7  ,7  ,7  ,0  ,7  ,7  ,7  ,0  ,0  ,7  ,7  ,15 ,15
  682.     DATA 15 ,7  ,7  ,7  ,7  ,7  ,7  ,0  ,0  ,0  ,7  ,7  ,7  ,7  ,7  ,15
  683.     DATA 15,7   ,7  ,7  ,7  ,7  ,7  ,0  ,0  ,7  ,7  ,7  ,7  ,7  ,7  ,15
  684.     DATA 15,15  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,15
  685.     DATA 255,15 ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,255
  686.     DATA 255,15 ,15 ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,15 ,255
  687.     DATA 255,255,15 ,15 ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,15 ,255,255
  688.     DATA 255,255,255,15 ,15 ,7  ,7  ,7  ,7  ,7  ,7  ,15 ,15 ,255,255,255
  689.     DATA 255,255,255,255,15 ,15 ,15 ,7  ,7  ,15 ,15 ,15 ,255,255,255,255
  690.     DATA 255,255,255,255,255,255,15 ,15 ,15 ,15 ,255,255,255,255,255,255
  691.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
  692.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
  693.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
  694.     DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
  695.  
  696.  
  697.     SUB GETKEY (KEYP$)
  698.     '*************************************************************************
  699.     '* THIS ROUTINE WAITS FOR A KEY STROKE
  700.     '*************************************************************************
  701.     FOR A = 0 TO 7 '* CLEAR THE KBD BUFFER
  702.         A$ = INKEY$
  703.     NEXT A
  704.     SOUND 700, .75
  705.     A$ = ""
  706.     WHILE A$ = ""
  707.         A$ = INKEY$
  708.         IF A$ = "q" THEN
  709.             A$ = "Q"
  710.         END IF
  711.         IF A$ = "s" THEN
  712.             A$ = "S"
  713.         END IF
  714.     WEND
  715.     KEYP$ = A$
  716.     END SUB
  717.  
  718.