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