home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / svgapb21 / svgamod2.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-09  |  37.6 KB  |  1,214 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.     $INCLUDE "SVGAPB.BI"
  44.     $INCLUDE "SVGADEMO.BI"
  45.  
  46.     DEFINT A-Z
  47.     
  48.     
  49.     SUB DO2D (RET$)
  50.     DIM POINTARRY(0 TO 8) AS P2DType
  51.  
  52.     '*************************************************************************
  53.     '* SET UP THE TITLE
  54.     '*************************************************************************
  55.     TITLE$ = "DEMO 11: 2D functions"
  56.     PALSET PAL(0), 0, 255
  57.  
  58.     '*************************************************************************
  59.     '* SET UP THE 'STAR' PATTERN OF POINTS
  60.     '*************************************************************************
  61.     SETVIEW 0, 0, GETMAXX, GETMAXY
  62.     CNTX = GETMAXX \ 2
  63.     CNTY = ((GETMAXY - 32) \ 2) + 32
  64.     SPCNG = GETMAXX \ 30
  65.     POINTARRY(0).X = 0
  66.     POINTARRY(0).Y = -SPCNG * 6
  67.     POINTARRY(1).X = SPCNG * 2
  68.     POINTARRY(1).Y = -SPCNG * 2
  69.     POINTARRY(2).X = SPCNG * 6
  70.     POINTARRY(2).Y = 0
  71.     POINTARRY(3).X = SPCNG * 2
  72.     POINTARRY(3).Y = SPCNG * 2
  73.     POINTARRY(4).X = 0
  74.     POINTARRY(4).Y = SPCNG * 6
  75.     POINTARRY(5).X = -SPCNG * 2
  76.     POINTARRY(5).Y = SPCNG * 2
  77.     POINTARRY(6).X = -SPCNG * 6
  78.     POINTARRY(6).Y = 0
  79.     POINTARRY(7).X = -SPCNG * 2
  80.     POINTARRY(7).Y = -SPCNG * 2
  81.     POINTARRY(8).X = 0
  82.     POINTARRY(8).Y = -SPCNG * 6
  83.  
  84.     '*************************************************************************
  85.     '* SHOW D2TRANSLATE
  86.     '*************************************************************************
  87.     FILLSCREEN 0
  88.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  89.     A$ = "D2TRANSLATE (Points,XTrans,YTrans,InAry,OutAry)"
  90.     DRWSTRING 1, 7, 0, A$, 10, 16
  91.     SETVIEW 0, 32, GETMAXX, GETMAXY
  92.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  93.     SHOWSTAR
  94.     GETKEY RET$
  95.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  96.         FILLSCREEN 0
  97.         SETVIEW 0, 0, GETMAXX, GETMAXY
  98.         EXIT SUB
  99.     END IF
  100.     XTRANS = 0
  101.     YTRANS = 0
  102.     FOR J = 0 TO SPCNG * 2
  103.         XTRANS = XTRANS + 2
  104.         YTRANS = YTRANS + 2
  105.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  106.         SHOWSTAR
  107.         SDELAY 2
  108.     NEXT J
  109.     FOR J = 0 TO SPCNG * 2
  110.         XTRANS = XTRANS - 2
  111.         YTRANS = YTRANS - 2
  112.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  113.         SHOWSTAR
  114.         SDELAY 2
  115.     NEXT J
  116.     GETKEY RET$
  117.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  118.         FILLSCREEN 0
  119.         SETVIEW 0, 0, GETMAXX, GETMAXY
  120.         EXIT SUB
  121.     END IF
  122.  
  123.     '*************************************************************************
  124.     '* SHOW D2SCALE
  125.     '*************************************************************************
  126.     SETVIEW 0, 0, GETMAXX, 31
  127.     FILLVIEW 0
  128.     SETVIEW 0, 0, GETMAXX, GETMAXY
  129.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  130.     A$ = "D2SCALE (Points,XScale,YScale,InAry,OutAry)"
  131.     DRWSTRING 1, 7, 0, A$, 10, 16
  132.     SETVIEW 0, 32, GETMAXX, GETMAXY
  133.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  134.     SHOWSTAR
  135.     FOR J = 256 TO 380 STEP 4
  136.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  137.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  138.         SHOWSTAR
  139.         SDELAY 2
  140.         NEXT J
  141.     X = J
  142.     FOR J = X TO 256 STEP -4
  143.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  144.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  145.         SHOWSTAR
  146.         SDELAY 2
  147.     NEXT J
  148.     X = J
  149.     FOR J = X TO 128 STEP -4
  150.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  151.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  152.         SHOWSTAR
  153.         SDELAY 2
  154.     NEXT J
  155.     X = J
  156.     FOR J = X TO 256 STEP 4
  157.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  158.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  159.         SHOWSTAR
  160.         SDELAY 2
  161.     NEXT J
  162.     GETKEY RET$
  163.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  164.         FILLSCREEN 0
  165.         SETVIEW 0, 0, GETMAXX, GETMAXY
  166.         EXIT SUB
  167.     END IF
  168.  
  169.     '*************************************************************************
  170.     '* SHOW D2ROTATE (ABOUT THE CENTER OF THE OBJECT)
  171.     '*************************************************************************
  172.     SETVIEW 0, 0, GETMAXX, 31
  173.     FILLVIEW 0
  174.     SETVIEW 0, 0, GETMAXX, GETMAXY
  175.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  176.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  177.     DRWSTRING 1, 7, 0, A$, 10, 16
  178.     A$ = "Lets do it about the center of the object."
  179.     DRWSTRING 1, 7, 0, A$, 10, 32
  180.     SETVIEW 0, 32, GETMAXX, GETMAXY
  181.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  182.     SHOWSTAR
  183.     FOR J = 0 TO 180
  184.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  185.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  186.         SHOWSTAR
  187.         SDELAY 2
  188.     NEXT J
  189.     FOR J = 180 TO 0 STEP -2
  190.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  191.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  192.         SHOWSTAR
  193.         SDELAY 2
  194.     NEXT J
  195.     GETKEY RET$
  196.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  197.         FILLSCREEN 0
  198.         SETVIEW 0, 0, GETMAXX, GETMAXY
  199.         EXIT SUB
  200.     END IF
  201.  
  202.     '*************************************************************************
  203.     '* SHOW D2ROTATE (ABOUT AN ARBITRARY POINT)
  204.     '*************************************************************************
  205.     SETVIEW 0, 0, GETMAXX, 48
  206.     FILLVIEW 0
  207.     SETVIEW 0, 0, GETMAXX, GETMAXY
  208.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  209.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  210.     DRWSTRING 1, 7, 0, A$, 10, 16
  211.     A$ = "Lets do it about an arbitrary point."
  212.     DRWSTRING 1, 7, 0, A$, 10, 32
  213.     SETVIEW 0, 32, GETMAXX, GETMAXY
  214.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  215.     SHOWSTAR
  216.     FOR J = 0 TO 360 STEP 2
  217.         D2ROTATE 9, 0, SPCNG * 6, J, POINTARRY(0).X, PLOTARRY(0).X
  218.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  219.         SHOWSTAR
  220.         SDELAY 2
  221.     NEXT J
  222.     SETVIEW 0, 0, GETMAXX, GETMAXY
  223.     GETKEY RET$
  224.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  225.         FILLSCREEN 0
  226.         EXIT SUB
  227.     END IF
  228.     END SUB
  229.     
  230.     
  231.     SUB DO3D (RET$)
  232.     
  233.     '*************************************************************************
  234.     '* SET UP THE TITLE
  235.     '*************************************************************************
  236.     TITLE$ = "DEMO 12: 3D functions"
  237.     PALSET PAL(0), 0, 255
  238.  
  239.     '*************************************************************************
  240.     '* SET UP THE 'HOUSE' PATTERN OF POINTS
  241.     '*************************************************************************
  242.     SETVIEW 0, 0, GETMAXX, GETMAXY
  243.     CNTX = GETMAXX \ 2
  244.     CNTY = ((GETMAXY - 32) \ 2) + 32
  245.     CNTZ = 0
  246.     SPCNG = GETMAXX \ 6
  247.     POINTARRY3D(0).X = -SPCNG
  248.     POINTARRY3D(0).Y = -SPCNG * 2
  249.     POINTARRY3D(0).Z = 0
  250.     POINTARRY3D(1).X = SPCNG
  251.     POINTARRY3D(1).Y = -SPCNG * 2
  252.     POINTARRY3D(1).Z = 0
  253.     POINTARRY3D(2).X = SPCNG
  254.     POINTARRY3D(2).Y = -SPCNG * 2
  255.     POINTARRY3D(2).Z = SPCNG * 2
  256.     POINTARRY3D(3).X = -SPCNG
  257.     POINTARRY3D(3).Y = -SPCNG * 2
  258.     POINTARRY3D(3).Z = SPCNG * 2
  259.     POINTARRY3D(4).X = -SPCNG
  260.     POINTARRY3D(4).Y = SPCNG * 2
  261.     POINTARRY3D(4).Z = 0
  262.     POINTARRY3D(5).X = SPCNG
  263.     POINTARRY3D(5).Y = SPCNG * 2
  264.     POINTARRY3D(5).Z = 0
  265.     POINTARRY3D(6).X = SPCNG
  266.     POINTARRY3D(6).Y = SPCNG * 2
  267.     POINTARRY3D(6).Z = SPCNG * 2
  268.     POINTARRY3D(7).X = -SPCNG
  269.     POINTARRY3D(7).Y = SPCNG * 2
  270.     POINTARRY3D(7).Z = SPCNG * 2
  271.     POINTARRY3D(8).X = 0
  272.     POINTARRY3D(8).Y = -SPCNG * 2
  273.     POINTARRY3D(8).Z = SPCNG * 3
  274.     POINTARRY3D(9).X = 0
  275.     POINTARRY3D(9).Y = SPCNG * 2
  276.     POINTARRY3D(9).Z = SPCNG * 3
  277.     POINTARRY3D(10).X = 0
  278.     POINTARRY3D(10).Z = 0
  279.     POINTARRY3D(10).Y = 0
  280.     POINTARRY3D(11).X = SPCNG * 4
  281.     POINTARRY3D(11).Z = 0
  282.     POINTARRY3D(11).Y = 0
  283.     POINTARRY3D(12).X = 0
  284.     POINTARRY3D(12).Z = 0
  285.     POINTARRY3D(12).Y = SPCNG * 4
  286.     POINTARRY3D(13).X = 0
  287.     POINTARRY3D(13).Z = SPCNG * 4
  288.     POINTARRY3D(13).Y = 0
  289.  
  290.     '*************************************************************************
  291.     '* SHOW D3PROJECT
  292.     '*************************************************************************
  293.     PI! = 4 * ATN(1) / 180
  294.     FILLSCREEN 0
  295.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  296.     A$ = "D3PROJECT (Points,ProjParams,InAry,OutAry)"
  297.     DRWSTRING 1, 7, 0, A$, 10, 16
  298.     SETVIEW 0, 32, GETMAXX, GETMAXY
  299.     HEIGHT = GETMAXY * 8
  300.     Radius = GETMAXX * 30
  301.     J = 110
  302.     PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  303.     PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  304.     PROJ.EYEZ = HEIGHT
  305.     PROJ.SCRD = ((Radius ^ 2 + HEIGHT ^ 2) ^ .5) \ 2
  306.     PROJ.THETA = J
  307.     PROJ.PHI = CINT(ATN(HEIGHT / -Radius) / PI!)
  308.     BYTECOPY POINTARRY3D(0).X, PLAYARRY(0).X, 84
  309.     R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  310.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  311.     SHOWHOUSE
  312.     GETKEY RET$
  313.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  314.         FILLSCREEN 0
  315.         SETVIEW 0, 0, GETMAXX, GETMAXY
  316.         EXIT SUB
  317.     END IF
  318.     FOR J = 112 TO 470 STEP 3
  319.         PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  320.         PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  321.         PROJ.THETA = J
  322.         R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  323.         SHOWHOUSE
  324.         SDELAY 2
  325.     NEXT J
  326.     GETKEY RET$
  327.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  328.         FILLSCREEN 0
  329.         SETVIEW 0, 0, GETMAXX, GETMAXY
  330.         EXIT SUB
  331.     END IF
  332.  
  333.     '*************************************************************************
  334.     '* SHOW D3TRANSLATE
  335.     '*************************************************************************
  336.     SETVIEW 0, 0, GETMAXX, 31
  337.     FILLVIEW 0
  338.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  339.     A$ = "D3TRANSLATE (Points,XTrans,YTrans,ZTrans,InAry,OutAry)"
  340.     DRWSTRING 1, 7, 0, A$, 10, 16
  341.     SETVIEW 0, 32, GETMAXX, GETMAXY
  342.     FOR J = 2 TO 300 STEP 6
  343.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  344.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  345.         SHOWHOUSE
  346.         SDELAY 2
  347.     NEXT J
  348.     X = J
  349.     FOR J = X TO 2 STEP -6
  350.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  351.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  352.         SHOWHOUSE
  353.         SDELAY 2
  354.     NEXT J
  355.     GETKEY RET$
  356.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  357.         FILLSCREEN 0
  358.         SETVIEW 0, 0, GETMAXX, GETMAXY
  359.         EXIT SUB
  360.     END IF
  361.  
  362.     '*************************************************************************
  363.     '* SHOW D3SCALE
  364.     '*************************************************************************
  365.     SETVIEW 0, 0, GETMAXX, 31
  366.     FILLVIEW 0
  367.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  368.     A$ = "D3SCALE (Points,XScale,YScale,ZScale,InAry,OutAry)"
  369.     DRWSTRING 1, 7, 0, A$, 10, 16
  370.     SETVIEW 0, 32, GETMAXX, GETMAXY
  371.     FOR J = 256 TO 380 STEP 4
  372.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  373.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  374.         SHOWHOUSE
  375.         SDELAY 2
  376.         NEXT J
  377.     X = J
  378.     FOR J = X TO 256 STEP -4
  379.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  380.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  381.         SHOWHOUSE
  382.         SDELAY 2
  383.     NEXT J
  384.     X = J
  385.     FOR J = X TO 128 STEP -4
  386.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  387.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  388.         SHOWHOUSE
  389.         SDELAY 2
  390.     NEXT J
  391.     X = J
  392.     FOR J = X TO 256 STEP 4
  393.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  394.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  395.         SHOWHOUSE
  396.         SDELAY 2
  397.     NEXT J
  398.     GETKEY RET$
  399.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  400.         FILLSCREEN 0
  401.         SETVIEW 0, 0, GETMAXX, GETMAXY
  402.         EXIT SUB
  403.     END IF
  404.  
  405.     '*************************************************************************
  406.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  407.     '*************************************************************************
  408.     SETVIEW 0, 0, GETMAXX, 31
  409.     FILLVIEW 0
  410.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  411.     A$ = "D3ROTATE (Points,XOrigin,YOrigin,ZOrigin,ZAngle,YAngle,XAngle,InAry,OutAry) "
  412.     DRWSTRING 1, 7, 0, A$, 10, 16
  413.     A$ = "Lets do it about the origin."
  414.     DRWSTRING 1, 7, 0, A$, 10, 32
  415.     SETVIEW 0, 32, GETMAXX, GETMAXY
  416.     FOR J = 0 TO 360 STEP 3
  417.         D3ROTATE 10, 0, 0, 0, 0, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  418.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  419.         SHOWHOUSE
  420.         SDELAY 2
  421.     NEXT J
  422.     GETKEY RET$
  423.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  424.         FILLSCREEN 0
  425.         SETVIEW 0, 0, GETMAXX, GETMAXY
  426.         EXIT SUB
  427.     END IF
  428.     END SUB
  429.  
  430.     
  431.     SUB DOGIF (RET$)
  432.  
  433.     '*************************************************************************
  434.     '* SET UP THE TITLE
  435.     '*************************************************************************
  436.     TITLE$ = "DEMO 8: GIF functions"
  437.  
  438.     '*************************************************************************
  439.     '* SHOW GIF GET INFO
  440.     '*************************************************************************
  441.     SETVIEW 0, 0, GETMAXX, GETMAXY
  442.     FILLSCREEN 0
  443.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  444.  
  445. LP:
  446.     A$ = "Please provide the name and full path (if not in the current drive/directory)"
  447.     B$ = "of a GIF file you would like to see..."
  448.     C$ = "Filename:"
  449.     DRWSTRING 1, 7, 0, A$, 10, 64
  450.     DRWSTRING 1, 7, 0, B$, 10, 80
  451.     DRWSTRING 1, 7, 0, C$, 10, 96
  452.     FILENAME$ = "_"
  453.     LENGTH = 0
  454.     EXT = 0
  455.     WHILE EXT = 0
  456.         DRWSTRING 1, 15, 0, FILENAME$, 82, 96
  457.         A$ = ""
  458.         WHILE LEN(A$) < 1 OR LEN(A$) > 1
  459.             A$ = INKEY$
  460.         WEND
  461.         A = ASC(A$)
  462.         IF A > 31 AND A < 128 THEN
  463.             FILENAME$ = LEFT$(FILENAME$, LENGTH) + A$ + "_"
  464.             LENGTH = LENGTH + 1
  465.         ELSE
  466.             IF A = 8 AND LENGTH > 0 THEN
  467.                 DRWSTRING 1, 15, 0, STRING$(LENGTH + 1, 32), 82, 96
  468.                 LENGTH = LENGTH - 1
  469.                 FILENAME$ = LEFT$(FILENAME$, LENGTH) + "_"
  470.             ELSEIF A = 13 THEN
  471.                 EXT = 1
  472.             END IF
  473.         END IF
  474.     WEND
  475.     FILENAME$ = LEFT$(FILENAME$, LENGTH)
  476.     IF LEN(FILENAME$) < 1 THEN
  477.         EXIT SUB '* OOPS! NO NAME GIVEN SO LET'S JUST BAIL OUT!
  478.     END IF
  479.     SHOWGIF RET$, FILENAME$
  480.     IF RET$ = "S" OR RET$ = "Q" THEN
  481.         FILLSCREEN 0
  482.         EXIT SUB
  483.     END IF
  484.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  485.     A$ = "Would you like to see another (Y/N) ?"
  486.     DRWSTRING 1, 7, 0, A$, 10, 64
  487.     EXT = 0
  488.     SOUND 700, .75
  489.     WHILE EXT = 0
  490.         A$ = ""
  491.         WHILE A$ = ""
  492.             A$ = INKEY$
  493.         WEND
  494.         IF A$ = "Y" OR A$ = "y" THEN
  495.             GOTO LP
  496.         ELSEIF A$ = "N" OR A$ = "n" THEN
  497.             EXT = 1
  498.         ELSE
  499.             SOUND 100, 5
  500.         END IF
  501.     WEND
  502.     FILLSCREEN 0
  503.     END SUB
  504.  
  505.     
  506.     SUB DOJOYSTICK (RET$)
  507.  
  508.     '*************************************************************************
  509.     '* SET UP THE TITLE
  510.     '*************************************************************************
  511.     TITLE$ = "DEMO 10: Joystick functions"
  512.     PALSET PAL(0), 0, 255
  513.     FILLSCREEN 0
  514.     SETVIEW 0, 0, GETMAXX, GETMAXY
  515.  
  516.     '*************************************************************************
  517.     '* CHECK TO SEE IF WE HAVE A JOYSTICK SO WE CAN DO THE JOYSTICK DEMO
  518.     '*************************************************************************
  519.     JOYSTICK = WHICHJOYSTICK
  520.     IF JOYSTICK < 1 THEN
  521.         SOUND 100, 5
  522.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  523.         A$ = "Sorry, No Joystick Detected...Can Not Do The Joystick Demo."
  524.         DRWSTRING 1, 7, 0, A$, 10, 16
  525.         WHILE INKEY$ = ""
  526.         WEND
  527.         FILLSCREEN 0
  528.         EXIT SUB
  529.     END IF
  530.  
  531.     '*************************************************************************
  532.     '* SHOW JOYSTICKINFO (HERE WE DO SOME JOYSTICK CALIBRATION)
  533.     '*************************************************************************
  534.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  535.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  536.     DRWSTRING 1, 7, 0, A$, 10, 16
  537.     SETVIEW 0, 0, GETMAXX, GETMAXY
  538.     SELECT CASE JOYSTICK
  539.         CASE = 1
  540.             A$ = "Please Move Joystick A As Far As It Will Go In All Directions"
  541.         CASE = 2
  542.             A$ = "Please Move Joystick B As Far As It Will Go In All Directions"
  543.         CASE = 3
  544.             A$ = "Please Move Both Joystick A And B As Far As They Will Go In All Directions"
  545.     END SELECT
  546.     DRWSTRING 1, 7, 0, A$, 10, 32
  547.     A$ = "And Then Press A Key..."
  548.     DRWSTRING 1, 7, 0, A$, 10, 48
  549.     SOUND 700, .75
  550.     GETMAXXA = -1
  551.     MAXYA = -1
  552.     MINXA = 10000
  553.     MINYA = 10000
  554.     GETMAXXB = -1
  555.     MAXYB = -1
  556.     MINXB = 10000
  557.     MINYB = 10000
  558.     A$ = ""
  559.     WHILE A$ = ""
  560.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  561.         IF JAX > GETMAXXA THEN
  562.             GETMAXXA = JAX
  563.         END IF
  564.         IF JAX < MINXA THEN
  565.             MINXA = JAX
  566.         END IF
  567.         IF JAY > MAXYA THEN
  568.             MAXYA = JAY
  569.         END IF
  570.         IF JAY < MINYA THEN
  571.             MINYA = JAY
  572.         END IF
  573.         IF JBX > GETMAXXB THEN
  574.             GETMAXXB = JBX
  575.         END IF
  576.         IF JBX < MINXB THEN
  577.             MINXB = JBX
  578.         END IF
  579.         IF JBY > MAXYB THEN
  580.             MAXYB = JBY
  581.         END IF
  582.         IF JBY < MINYB THEN
  583.             MINYB = JBY
  584.         END IF
  585.         A$ = INKEY$
  586.     WEND
  587.  
  588.     '*************************************************************************
  589.     '* CALCULATE THE CENTER AND STUFF...
  590.     '*************************************************************************
  591.     SPCNG = GETMAXX \ 7
  592.     DIST = SPCNG * 2
  593.     X1 = SPCNG \ 2
  594.     Y1 = SPCNG \ 2 + 32
  595.     X2 = X1 + DIST
  596.     Y2 = Y1 + DIST
  597.     X4 = GETMAXX - SPCNG
  598.     Y4 = Y2
  599.     X3 = X4 - DIST
  600.     Y3 = Y1
  601.     CNTAX = (X2 - X1) / 2 + X1
  602.     CNTAY = (Y2 - Y1) / 2 + Y1
  603.     CNTBX = (X4 - X3) / 2 + X3
  604.     CNTBY = (Y4 - Y3) / 2 + Y3
  605.     RANGEXA = GETMAXXA - MINXA
  606.     RANGEYA = MAXYA - MINYA
  607.     RANGEXB = GETMAXXB - MINXB
  608.     RANGEYB = MAXYB - MINYB
  609.     JABAX = (X2 - X1) \ 4 + X1 - 16
  610.     JABAY = (SPCNG \ 4) + Y2 - 6
  611.     JABBX = X2 - (X2 - X1) \ 4 - 16
  612.     JABBY = (SPCNG \ 4) + Y2 - 6
  613.     JBBAX = (X4 - X3) \ 4 + X3 - 16
  614.     JBBAY = (SPCNG \ 4) + Y4 - 6
  615.     JBBBX = X4 - (X4 - X3) \ 4 - 16
  616.     JBBBY = (SPCNG \ 4) + Y4 - 6
  617.  
  618.     '*************************************************************************
  619.     '* LETS MOVE IT (OR THEM) AROUND
  620.     '*************************************************************************
  621.     SETVIEW 0, 0, GETMAXX, 64
  622.     FILLVIEW 0
  623.     SETVIEW 0, 0, GETMAXX, GETMAXY
  624.     IF (JOYSTICK AND 1) = 1 THEN
  625.         DRWBOX 1, 15, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  626.         DRWBOX 1, 15, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  627.         DRWLINE 1, 15, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  628.         OAX = CNTAX
  629.         OAY = CNTAY
  630.         DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  631.     ELSE
  632.         DRWBOX 1, 8, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  633.         DRWBOX 1, 8, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  634.         DRWLINE 1, 8, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  635.     END IF
  636.     IF (JOYSTICK AND 2) = 2 THEN
  637.         DRWBOX 1, 15, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  638.         DRWBOX 1, 15, X3 - 1, Y4 + 1, X4 + 1, Y4 + SPCNG \ 2
  639.         DRWLINE 1, 15, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  640.         OBX = CNTBX
  641.         OBY = CNTBY
  642.         DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  643.     ELSE
  644.         DRWBOX 1, 8, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  645.         DRWBOX 1, 8, X3 - 1, Y4 + 1, X4 + 1, Y4 + SPCNG \ 2
  646.         DRWLINE 1, 8, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  647.     END IF
  648.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  649.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  650.     DRWSTRING 1, 7, 0, A$, 10, 16
  651.     SETVIEW 0, 32, GETMAXX, GETMAXY
  652.     A$ = ""
  653.     WHILE A$ = ""
  654.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  655.         IF (JOYSTICK AND 1) = 1 THEN
  656.             SETVIEW X1, Y1, X2, Y2
  657.             JAX = JAX - MINXA
  658.             JAX = JAX / RANGEXA * DIST + X1
  659.             JAY = JAY - MINYA
  660.             JAY = JAY / RANGEYA * DIST + Y1
  661.             DRWLINE 1, 0, CNTAX, CNTAY, OAX, OAY
  662.             OAX = JAX
  663.             OAY = JAY
  664.             DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  665.             SETVIEW 0, 0, GETMAXX, GETMAXY
  666.             IF (JAButs AND 1) = 1 THEN
  667.                 DRWSTRING 1, 10, 0, "ButA", JABAX, JABAY
  668.             ELSE
  669.                 DRWSTRING 1, 8, 0, "ButA", JABAX, JABAY
  670.             END IF
  671.             IF (JAButs AND 2) = 2 THEN
  672.                 DRWSTRING 1, 10, 0, "ButB", JABBX, JABBY
  673.             ELSE
  674.                 DRWSTRING 1, 8, 0, "ButB", JABBX, JABBY
  675.             END IF
  676.         END IF
  677.         IF (JOYSTICK AND 2) = 2 THEN
  678.             SETVIEW X3, Y3, X4, Y4
  679.             JBX = JBX - MINXB
  680.             JBX = JBX / RANGEXB * DIST + X3
  681.             JBY = JBY - MINYB
  682.             JBY = JBY / RANGEYB * DIST + Y3
  683.             DRWLINE 1, 0, CNTBX, CNTBY, OBX, OBY
  684.             OBX = JBX
  685.             OBY = JBY
  686.             DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  687.             SETVIEW 0, 0, GETMAXX, GETMAXY
  688.             IF (JBButs AND 1) = 1 THEN
  689.                 DRWSTRING 1, 10, 0, "ButA", JBBAX, JBBAY
  690.             ELSE
  691.                 DRWSTRING 1, 8, 0, "ButA", JBBAX, JBBAY
  692.             END IF
  693.             IF (JBButs AND 2) = 2 THEN
  694.                 DRWSTRING 1, 10, 0, "ButB", JBBBX, JBBBY
  695.             ELSE
  696.                 DRWSTRING 1, 8, 0, "ButB", JBBBX, JBBBY
  697.             END IF
  698.         END IF
  699.         A$ = INKEY$
  700.     WEND
  701.     RET$ = A$
  702.     IF RET$ = "q" THEN
  703.         RET$ = "Q"
  704.     END IF
  705.     IF RET$ = "s" THEN
  706.         RET$ = "S"
  707.     END IF
  708.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  709.         FILLSCREEN 0
  710.         SETVIEW 0, 0, GETMAXX, GETMAXY
  711.         EXIT SUB
  712.     END IF
  713.     SETVIEW 0, 0, GETMAXX, GETMAXY
  714.     END SUB
  715.  
  716.     
  717.     SUB DOMOUSE (RET$)
  718.  
  719.     '*************************************************************************
  720.     '* SET UP THE TITLE
  721.     '*************************************************************************
  722.     TITLE$ = "DEMO 9: Mouse functions"
  723.     FILLSCREEN 0
  724.     PALSET PAL(0), 0, 255
  725.     SETVIEW 0, 0, GETMAXX, GETMAXY
  726.  
  727.     '*************************************************************************
  728.     '* CHECK TO SEE IF WE HAVE A MOUSE SO WE CAN DO THE MOUSE DEMO
  729.     '*************************************************************************
  730.     MOUSE = WHICHMOUSE
  731.     IF MOUSE < 1 THEN
  732.         SOUND 100, 5
  733.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  734.         A$ = "Sorry, No Mouse Detected...Can Not Do The Mouse Demo."
  735.         DRWSTRING 1, 7, 0, A$, 10, 16
  736.         WHILE INKEY$ = ""
  737.         WEND
  738.         FILLSCREEN 0
  739.         EXIT SUB
  740.     ELSE
  741.         Colr = 16
  742.         FOR I = 0 TO GETMAXX \ 2
  743.             DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
  744.             Colr = Colr + 2
  745.             IF Colr > 255 THEN
  746.                 Colr = 16
  747.             END IF
  748.         NEXT I
  749.     END IF
  750.  
  751.     '*************************************************************************
  752.     '* SHOW MOUSESHOW
  753.     '*************************************************************************
  754.     SETVIEW 0, 0, GETMAXX, 31
  755.     FILLVIEW 0
  756.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  757.     A$ = "MOUSESHOW ()"
  758.     DRWSTRING 1, 7, 0, A$, 10, 16
  759.     SETVIEW 0, 32, GETMAXX, GETMAXY
  760.     MOUSEENTER '*MUST BE CALLED FIRST TO ENABLE MOUSE FUNCTIONS
  761.     MOUSESHOW
  762.     GETKEY RET$
  763.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  764.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  765.         FILLSCREEN 0
  766.         SETVIEW 0, 0, GETMAXX, GETMAXY
  767.         EXIT SUB
  768.     END IF
  769.  
  770.     '*************************************************************************
  771.     '* SHOW MOUSESTATUS
  772.     '*************************************************************************
  773.     MOUSEHIDE
  774.     SETVIEW 0, 0, GETMAXX, 31
  775.     FILLVIEW 0
  776.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  777.     A$ = "MOUSESTATUS (Xloc,Yloc,MButs)"
  778.     DRWSTRING 1, 7, 0, A$, 10, 16
  779.     MOUSESHOW
  780.     SETVIEW 0, 32, GETMAXX, GETMAXY
  781.     A$ = ""
  782.     SOUND 700, .75
  783.     WHILE A$ = ""
  784.         MOUSESTATUS X, Y, MButs
  785.         IF MButs AND 1 THEN
  786.             LB = 1
  787.         ELSE
  788.             LB = 0
  789.         END IF
  790.         IF MButs AND 2 THEN
  791.             RB = 1
  792.         ELSE
  793.             RB = 0
  794.         END IF
  795.         IF MButs AND 4 THEN
  796.             CB = 1
  797.         ELSE
  798.             CB = 0
  799.         END IF
  800.         D$ = "X=" + STR$(X)
  801.         L = LEN(D$)
  802.         IF L < 10 THEN
  803.             D$ = D$ + STRING$(8 - L, 32)
  804.         END IF
  805.         D$ = D$ + "Y=" + STR$(Y)
  806.         L = LEN(D$)
  807.         IF L < 20 THEN
  808.             D$ = D$ + STRING$(16 - L, 32)
  809.         END IF
  810.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  811.         DRWSTRING 1, 15, 8, D$, 10, 32
  812.         A$ = INKEY$
  813.     WEND
  814.     RET$ = A$
  815.     IF RET$ = "q" THEN
  816.         RET$ = "Q"
  817.     END IF
  818.     IF RET$ = "s" THEN
  819.         RET$ = "S"
  820.     END IF
  821.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  822.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  823.         FILLSCREEN 0
  824.         SETVIEW 0, 0, GETMAXX, GETMAXY
  825.         EXIT SUB
  826.     END IF
  827.  
  828.     '*************************************************************************
  829.     '* SHOW MOUSEHIDE
  830.     '*************************************************************************
  831.     MOUSEHIDE
  832.     SETVIEW 0, 0, GETMAXX, 31
  833.     FILLVIEW 0
  834.     SETVIEW 0, 0, GETMAXX, GETMAXY
  835.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  836.     A$ = "MOUSEHIDE ()"
  837.     DRWSTRING 1, 7, 0, A$, 10, 16
  838.     SETVIEW 0, 32, GETMAXX, GETMAXY
  839.     A$ = ""
  840.     SOUND 700, .75
  841.     WHILE A$ = ""
  842.         MOUSESTATUS X, Y, MButs
  843.         IF MButs AND 1 THEN
  844.             LB = 1
  845.         ELSE
  846.             LB = 0
  847.         END IF
  848.         IF MButs AND 2 THEN
  849.             RB = 1
  850.         ELSE
  851.             RB = 0
  852.         END IF
  853.         IF MButs AND 4 THEN
  854.             CB = 1
  855.         ELSE
  856.             CB = 0
  857.         END IF
  858.         D$ = "X=" + STR$(X)
  859.         L = LEN(D$)
  860.         IF L < 10 THEN
  861.             D$ = D$ + STRING$(8 - L, 32)
  862.         END IF
  863.         D$ = D$ + "Y=" + STR$(Y)
  864.         L = LEN(D$)
  865.         IF L < 20 THEN
  866.             D$ = D$ + STRING$(16 - L, 32)
  867.         END IF
  868.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  869.         DRWSTRING 1, 15, 8, D$, 10, 32
  870.         A$ = INKEY$
  871.     WEND
  872.     MOUSESHOW
  873.     RET$ = A$
  874.     IF RET$ = "q" THEN
  875.         RET$ = "Q"
  876.     END IF
  877.     IF RET$ = "s" THEN
  878.         RET$ = "S"
  879.     END IF
  880.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  881.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  882.         FILLSCREEN 0
  883.         SETVIEW 0, 0, GETMAXX, GETMAXY
  884.         EXIT SUB
  885.     END IF
  886.  
  887.     '*************************************************************************
  888.     '* SHOW MOUSERANGESET
  889.     '*************************************************************************
  890.     MOUSEHIDE
  891.     SETVIEW 0, 0, GETMAXX, 48
  892.     FILLVIEW 0
  893.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  894.     A$ = "MOUSERANGESET (X1,Y1,X2,Y2)"
  895.     DRWSTRING 1, 7, 0, A$, 10, 16
  896.     SETVIEW 0, 0, GETMAXX, GETMAXY
  897.     SPCNG = (GETMAXY - 32) \ 3
  898.     X1 = SPCNG
  899.     Y1 = 32 + SPCNG
  900.     X2 = GETMAXX - SPCNG
  901.     Y2 = GETMAXY - SPCNG
  902.     DRWBOX 1, 15, X1, Y1, X2, Y2
  903.     MOUSESHOW
  904.     MOUSERANGESET X1, Y1, X2, Y2
  905.     GETKEY RET$
  906.     MOUSERANGESET 0, 0, GETMAXX, GETMAXY
  907.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  908.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  909.         FILLSCREEN 0
  910.         SETVIEW 0, 0, GETMAXX, GETMAXY
  911.         EXIT SUB
  912.     END IF
  913.     
  914.     '*************************************************************************
  915.     '* SHOW MOUSECURSORSET USE THE MAGNIFIER
  916.     '*************************************************************************
  917.     SETVIEW 0, 0, GETMAXX, 31
  918.     FILLVIEW 0
  919.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  920.     A$ = "MOUSECURSORSET (MouseCursor?)"
  921.     DRWSTRING 1, 7, 0, A$, 10, 16
  922.     SETVIEW 0, 32, GETMAXX, GETMAXY
  923.     MOUSECURSORSET MAGMOUSECURSOR(0)
  924.     GETKEY RET$
  925.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  926.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  927.         FILLSCREEN 0
  928.         SETVIEW 0, 0, GETMAXX, GETMAXY
  929.         EXIT SUB
  930.     END IF
  931.  
  932.     '*************************************************************************
  933.     '* SHOW MOUSECURSORSET USE THE BIG ARROW
  934.     '*************************************************************************
  935.     SETVIEW 0, 32, GETMAXX, GETMAXY
  936.     MOUSECURSORSET BIGMOUSECURSOR(0)
  937.     GETKEY RET$
  938.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  939.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  940.         FILLSCREEN 0
  941.         SETVIEW 0, 0, GETMAXX, GETMAXY
  942.         EXIT SUB
  943.     END IF
  944.  
  945.     '*************************************************************************
  946.     '* SHOW MOUSECURSORSET USE THE STOPWATCH
  947.     '*************************************************************************
  948.     MOUSECURSORSET STWMOUSECURSOR(0)
  949.     GETKEY RET$
  950.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  951.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  952.         FILLSCREEN 0
  953.         SETVIEW 0, 0, GETMAXX, GETMAXY
  954.         EXIT SUB
  955.     END IF
  956.  
  957.     '*************************************************************************
  958.     '* SHOW MOUSECURSORDEFAULT
  959.     '*************************************************************************
  960.     MOUSEHIDE
  961.     SETVIEW 0, 0, GETMAXX, 31
  962.     FILLVIEW 0
  963.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  964.     A$ = "MOUSECURSORDEFAULT ()"
  965.     DRWSTRING 1, 7, 0, A$, 10, 16
  966.     MOUSESHOW
  967.     SETVIEW 0, 32, GETMAXX, GETMAXY
  968.     MOUSECURSORDEFAULT
  969.     GETKEY RET$
  970.     MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  971.     FILLSCREEN 0
  972.     SETVIEW 0, 0, GETMAXX, GETMAXY
  973.     END SUB
  974.  
  975.     
  976.     SUB SHOWGIF (RET$, FILENAME$)
  977.  
  978.     '*************************************************************************
  979.     '* THIS ROUTINE IS CALLED BY DOGIF
  980.     '*************************************************************************
  981.     TITLE$ = "DEMO 8: GIF functions"
  982.  
  983.     '*************************************************************************
  984.     '* SHOW GIF GET INFO
  985.     '*************************************************************************
  986.     FILLSCREEN 0
  987.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  988.     A$ = "GIFGETINFO(FileName$,GifXSize,GifYSize,NumColors,Palette)"
  989.     DRWSTRING 1, 7, 0, A$, 10, 16
  990.     GIFFILENAME$ = FILENAME$
  991.     OK = GIFGETINFO(GIFFILENAME$, XSIZE, YSIZE, NUMCOL, GIFPAL(0))
  992.     MINCOLOR = 0
  993.     MAXCOLOR = 0
  994.     MINCOLORBRITENESS = 765
  995.     MAXCOLORBRITENESS = 0
  996.     IF OK = 1 THEN
  997.         '*********************************************************************
  998.         '* WE NEED TO CHECK THE GIF COLOR PALETTE ENTRIES TO SEE IF ANY COLORS
  999.         '* ARE GREATER THE SIX BITS IN LENGTH AS THE VGA COLOR PALETTE
  1000.         '* REGISTERS ARE ONLY SIX BITS WIDE. WE ALSO LOOK FOR THE BRIGHTEST
  1001.         '* AND DARKEST COLORS TO USE AS OUR TEXT AND BACKGROUND COLORS
  1002.         '*********************************************************************
  1003.         FIXIT = 0
  1004.         FOR I = 0 TO NUMCOL - 1
  1005.             IF GIFPAL(I).R > 63 THEN
  1006.                 FIXIT = 1
  1007.             END IF
  1008.             IF GIFPAL(I).G > 63 THEN
  1009.                 FIXIT = 1
  1010.             END IF
  1011.             IF GIFPAL(I).B > 63 THEN
  1012.                 FIXIT = 1
  1013.             END IF
  1014.             COLORBRIGHTNESS = GIFPAL(I).R + GIFPAL(I).G + GIFPAL(I).B
  1015.             IF COLORBRIGHTNESS < MINCOLORBRITENESS THEN  '* FIND THE DARKEST COLOR FOR THE BACKGROUND
  1016.                 MINCOLORCOLORBRITENESS = COLORBRIGHTNESS
  1017.                 MINCOLOR = I
  1018.             END IF
  1019.             IF TEST > MAXCOLORBRITENESS THEN
  1020.                 MAXCOLORCOLORBRITENESS = COLORBRIGHTNESS      '* FIND THE BRIGHTEST COLOR FOR THE TEXT
  1021.                 MAXCOLOR = I
  1022.             END IF
  1023.         NEXT I
  1024.         '*********************************************************************
  1025.         '* IF THE GIF USES 8 BIT COLOR THEN WE SHIFT EACH COLOR ENTRY RIGHT
  1026.         '* BY 2 BITS (THIS REDUCES IT TO 6 BITS OF COLOR)
  1027.         '*********************************************************************
  1028.         IF FIXIT = 1 THEN
  1029.             FOR A = 0 TO NUMCOL
  1030.                 SHIFT RIGHT GIFPAL(A).R, 2
  1031.                 SHIFT RIGHT GIFPAL(A).G, 2
  1032.                 SHIFT RIGHT GIFPAL(A).B, 2
  1033.             NEXT A
  1034.         END IF
  1035.         '*********************************************************************
  1036.         '* IF THE GIF HAS A PALETTE OF 128 COLORS OR LESS THEN WE CAN USE
  1037.         '* OUR OWN COLORS FOR THE TEXT AND BACKGROUND
  1038.         '*********************************************************************
  1039.         IF NUMCOL < 128 THEN
  1040.             MINCOLOR = 254
  1041.             GIFPAL(MINCOLOR).R = 0   '* THIS IS THE COLOR BLACK
  1042.             GIFPAL(MINCOLOR).G = 0
  1043.             GIFPAL(MINCOLOR).B = 0
  1044.             MAXCOLOR = 255
  1045.             GIFPAL(MAXCOLOR).R = 255 '* THIS IS THE COLOR BRIGHT WHITE
  1046.             GIFPAL(MAXCOLOR).G = 255
  1047.             GIFPAL(MAXCOLOR).B = 255
  1048.         END IF
  1049.         A$ = "'" + GIFFILENAME$ + "' is identified as a 'Non-Interlaced' type 'GIF87a' GIF."
  1050.         DRWSTRING 1, 15, 0, A$, 10, 64
  1051.         A$ = "Dimensions are:" + STR$(XSIZE) + " pixels wide and" + STR$(YSIZE) + " pixels high"
  1052.         DRWSTRING 1, 15, 0, A$, 10, 80
  1053.         A$ = "Number of colors:" + STR$(NUMCOL)
  1054.         DRWSTRING 1, 15, 0, A$, 10, 96
  1055.         GETKEY RET$
  1056.         IF (RET$ = "S") OR (RET$ = "Q") THEN
  1057.             FILLSCREEN 0
  1058.             SETVIEW 0, 0, GETMAXX, GETMAXY
  1059.             EXIT SUB
  1060.         END IF
  1061.  
  1062.         '*********************************************************************
  1063.         '* SHOW GIF GETPUT
  1064.         '*********************************************************************
  1065.         PALSET GIFPAL(0), 0, 255
  1066.         OVERSCANSET MINCOLOR
  1067.         FILLSCREEN MINCOLOR
  1068.         DRWSTRING 1, MAXCOLOR, MINCOLOR, TITLE$, 10, 0
  1069.         A$ = "GIFPUT(Mode,X,Y,FileName$)"
  1070.         DRWSTRING 1, MAXCOLOR, MINCOLOR, A$, 10, 16
  1071.         SETVIEW 0, 32, GETMAXX, GETMAXY
  1072.         Xloc = (GETMAXX \ 2) - (XSIZE \ 2)
  1073.         Yloc = ((GETMAXY - 32) \ 2) - (YSIZE \ 2) + 32
  1074.         OK = GIFPUT(1, Xloc, Yloc, GIFFILENAME$)
  1075.         IF OK <> 1 THEN
  1076.         '*********************************************************************
  1077.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1078.         '********************************************************************
  1079.             SOUND 100, 5
  1080.             A$ = "The file '" + GIFFILENAME$ + "' "
  1081.             B$ = ""
  1082.             SELECT CASE OK
  1083.                 CASE = 0
  1084.                     A$ = A$ + "does not exist in the specified directory"
  1085.                     B$ = " or there is some disk I/O problem."
  1086.                 CASE = -1
  1087.                     A$ = A$ + "does not have the 'GIF87a' signature."
  1088.                 CASE = -2
  1089.                     A$ = A$ + "is an interlaced GIF."
  1090.                 CASE = -3
  1091.                     A$ = A$ + "does not use a global color map."
  1092.                 CASE = -4
  1093.                     A$ = A$ + "has some general error."
  1094.             END SELECT
  1095.             DRWSTRING 1, MINCOLOR, MAXCOLOR, A$, 10, 64
  1096.             DRWSTRING 1, MINCOLOR, MAXCOLOR, B$, 10, 80
  1097.         END IF
  1098.     ELSE
  1099.         '*********************************************************************
  1100.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1101.         '*********************************************************************
  1102.         SOUND 100, 5
  1103.         A$ = "The file '" + GIFFILENAME$ + "' "
  1104.         B$ = ""
  1105.         SELECT CASE OK
  1106.             CASE = 0
  1107.                 A$ = A$ + "does not exist in the specified directory"
  1108.                 B$ = " or there is some disk I/O problem."
  1109.             CASE = -1
  1110.                 A$ = A$ + "does not have the 'GIF87a' signature."
  1111.             CASE = -2
  1112.                 A$ = A$ + "is an interlaced GIF."
  1113.             CASE = -3
  1114.                 A$ = A$ + "does not use a global color map."
  1115.             CASE = -4
  1116.                 A$ = A$ + "has some general error."
  1117.         END SELECT
  1118.         DRWSTRING 1, 15, 0, A$, 10, 64
  1119.         DRWSTRING 1, 15, 0, B$, 10, 80
  1120.     END IF
  1121.     GETKEY RET$
  1122.     PALSET ORGPAL(0), 0, 255
  1123.     OVERSCANSET 0
  1124.     FILLSCREEN 0
  1125.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1126.     END SUB
  1127.  
  1128.     
  1129.     SUB SHOWHOUSE
  1130.     
  1131.     SHARED OPLOTARRY()
  1132.     SHARED PLOTARRY()
  1133.  
  1134.     '*************************************************************************
  1135.     '* THIS ROUTINE IS CALLED BY DO3D
  1136.     '*************************************************************************
  1137.  
  1138.     '*************************************************************************
  1139.     '* ERASE THE OLD HOUSE
  1140.     '*************************************************************************
  1141.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(11).X, OPLOTARRY(11).Y
  1142.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(12).X, OPLOTARRY(12).Y
  1143.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(13).X, OPLOTARRY(13).Y
  1144.     FOR I = 0 TO 2
  1145.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1146.         DRWLINE 1, 0, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y, OPLOTARRY(I + 4 + 1).X, OPLOTARRY(I + 4 + 1).Y
  1147.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y
  1148.     NEXT I
  1149.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1150.     DRWLINE 1, 0, OPLOTARRY(0).X, OPLOTARRY(0).Y, OPLOTARRY(3).X, OPLOTARRY(3).Y
  1151.     DRWLINE 1, 0, OPLOTARRY(4).X, OPLOTARRY(4).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1152.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(8).X, OPLOTARRY(8).Y
  1153.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(2).X, OPLOTARRY(2).Y
  1154.     DRWLINE 1, 0, OPLOTARRY(7).X, OPLOTARRY(7).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1155.     DRWLINE 1, 0, OPLOTARRY(9).X, OPLOTARRY(9).Y, OPLOTARRY(6).X, OPLOTARRY(6).Y
  1156.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1157.  
  1158.     '*************************************************************************
  1159.     '* DRAW THE NEW HOUSE
  1160.     '*************************************************************************
  1161.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(11).X, PLOTARRY(11).Y
  1162.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(12).X, PLOTARRY(12).Y
  1163.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(13).X, PLOTARRY(13).Y
  1164.     FOR I = 0 TO 2
  1165.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1166.         DRWLINE 1, 10, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y, PLOTARRY(I + 4 + 1).X, PLOTARRY(I + 4 + 1).Y
  1167.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y
  1168.     NEXT I
  1169.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1170.     DRWLINE 1, 10, PLOTARRY(0).X, PLOTARRY(0).Y, PLOTARRY(3).X, PLOTARRY(3).Y
  1171.     DRWLINE 1, 10, PLOTARRY(4).X, PLOTARRY(4).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1172.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(8).X, PLOTARRY(8).Y
  1173.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(2).X, PLOTARRY(2).Y
  1174.     DRWLINE 1, 10, PLOTARRY(7).X, PLOTARRY(7).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1175.     DRWLINE 1, 10, PLOTARRY(9).X, PLOTARRY(9).Y, PLOTARRY(6).X, PLOTARRY(6).Y
  1176.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1177.  
  1178.     '*************************************************************************
  1179.     '* SAVE THE OLD POINTS
  1180.     '*************************************************************************
  1181.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  1182.     END SUB
  1183.  
  1184.     
  1185.     SUB SHOWSTAR
  1186.  
  1187.     SHARED OPLOTARRY()
  1188.     SHARED PLOTARRY()
  1189.  
  1190.     '*************************************************************************
  1191.     '* THIS ROUTINE IS CALLED BY DO2D
  1192.     '*************************************************************************
  1193.  
  1194.     '*************************************************************************
  1195.     '* ERASE THE OLD STAR
  1196.     '*************************************************************************
  1197.     FOR I = 0 TO 7
  1198.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1199.     NEXT I
  1200.  
  1201.     '*************************************************************************
  1202.     '* DRAW THE NEW STAR
  1203.     '*************************************************************************
  1204.     FOR I = 0 TO 7
  1205.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1206.     NEXT I
  1207.  
  1208.     '*************************************************************************
  1209.     '* SAVE THE OLD POINTS
  1210.     '*************************************************************************
  1211.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 36
  1212.     END SUB
  1213.  
  1214.