home *** CD-ROM | disk | FTP | other *** search
/ Shareware Supreme Volume 6 #1 / swsii.zip / swsii / 102 / SVGAQB10.ZIP / SVGAMOD1.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-06-11  |  27.9 KB  |  965 lines
  1.    
  2.     REM $INCLUDE: 'SVGAQB10.BI'
  3.     REM $INCLUDE: 'SVGADEMO.BI'
  4.  
  5. REM $DYNAMIC
  6.     SUB DOBLOCK (RET$, MAXX, MAXY)
  7.  
  8.     MYPI! = ATN(1) * 4
  9.  
  10.     '*************************************************************************
  11.     '* SET UP THE TITLE
  12.     '*************************************************************************
  13.     TITLE$ = "DEMO 5: Block functions and Sprites"
  14.     PALSET PAL, 0, 255
  15.    
  16.     '*************************************************************************
  17.     '* SHOW BLOCK GET (DRAW SOME CIRCLES AND "GET A CHUNK OF THEM")
  18.     '*************************************************************************
  19.     FILLSCREEN (0)
  20.     SETVIEW 0, 0, MAXX, MAXY
  21.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  22.     A$ = "BLKGET (X1,Y1,X2,Y2,GfxBlockArray)"
  23.     DRWSTRING 1, 7, 0, A$, 10, 16
  24.     Colr = 16
  25.     FOR I = 0 TO MAXX \ 2
  26.         DRWCIRCLE 1, Colr, MAXX \ 4 + I, MAXY \ 2, MAXY \ 5
  27.         Colr = Colr + 2
  28.         IF Colr > 255 THEN
  29.             Colr = 16
  30.         END IF
  31.     NEXT I
  32.     XINC = MAXX \ 20
  33.     YINC = MAXY \ 20
  34.     X1 = MAXX \ 2 - XINC
  35.     Y1 = MAXY \ 2 - YINC
  36.     X2 = MAXX \ 2 + XINC
  37.     Y2 = MAXY \ 2 + YINC
  38.     DRWBOX 1, 0, X1, Y1, X2, Y2
  39.     BLKGET X1, Y1, X2, Y2, GFXBLK(0)
  40.     GETKEY RET$
  41.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  42.         FILLSCREEN (0)
  43.         EXIT SUB
  44.     END IF
  45.  
  46.     '*************************************************************************
  47.     '* SHOW BLOCK PUT (PUT THE "CHUNKS" RANDOMLY AROUND THE SCREEN)
  48.     '*************************************************************************
  49.     A$ = "BLKPUT (Mode,X,Y,GfxBlockArray)   "
  50.     DRWSTRING 1, 7, 0, A$, 10, 16
  51.     XINC = MAXX \ 10
  52.     YINC = MAXY \ 10
  53.     SETVIEW 0, 32, MAXX, MAXY
  54.     FOR I = 0 TO MAXX \ 2
  55.         X = (MAXX + XINC) * RND - XINC
  56.         Y = (MAXY + YINC) * RND - YINC
  57.         BLKPUT 1, X, Y, GFXBLK(0)
  58.     NEXT I
  59.     GETKEY RET$
  60.     SETVIEW 0, 0, MAXX, MAXY
  61.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  62.         FILLSCREEN (0)
  63.         EXIT SUB
  64.     END IF
  65.  
  66.     '*************************************************************************
  67.     '* SHOW SPRITE GET/PUT
  68.     '*************************************************************************
  69.     FILLSCREEN (0)
  70.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  71.     A$ = "SPRITEPUT(TranSColr,X,Y,SpriteArray)"
  72.     DRWSTRING 1, 7, 0, A$, 10, 16
  73.     A$ = "SPRITEGAP(TranSColr,X,Y,SpriteArray,BackGroundArray)"
  74.     DRWSTRING 1, 7, 0, A$, 10, 32
  75.  
  76.     SETVIEW 0, 50, MAXX, MAXY
  77.     Colr = 16
  78.     X1 = 10
  79.     X2 = MAXX - 9
  80.     Y1 = 35
  81.     Y2 = MAXY - 9
  82.     I = 0
  83.     PALSET PAL, 16, 255
  84.     WHILE Y1 + I < Y2 - I
  85.         DRWBOX 1, Colr, X1 + I, Y1 + I, X2 - I, Y2 - I
  86.         Colr = Colr + 1
  87.         IF Colr > 255 THEN
  88.             Colr = 16
  89.         END IF
  90.         I = I + 1
  91.     WEND
  92.     GETKEY RET$
  93.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  94.         FILLSCREEN (0)
  95.         PALSET PAL, 16, 255
  96.         SETVIEW 0, 0, MAXX, MAXY
  97.         EXIT SUB
  98.     END IF
  99.     CNTX = (MAXX \ 2) - 8
  100.     CNTY = ((MAXY - 9) \ 2) - 8
  101.     J = 0
  102.     FOR DEG = 0 TO 360 STEP 2
  103.         RAD! = (DEG * MYPI! / 180)
  104.         X = CNTX + SIN(RAD!) * MAXY \ 4
  105.         Y = CNTY + COS(RAD!) * MAXY \ 4
  106.         SPRITEGAP 0, X, Y, SPRITEDATA(J), SPRITEBKGND(0)
  107.         SDELAY 3
  108.         SPRITEPUT 0, X, Y, SPRITEBKGND(0)
  109.         J = J + 130
  110.         IF J > 910 THEN
  111.             J = 0
  112.         END IF
  113.     NEXT DEG
  114.  
  115.     GETKEY RET$
  116.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  117.         FILLSCREEN (0)
  118.         PALSET PAL, 16, 255
  119.         SETVIEW 0, 0, MAXX, MAXY
  120.         EXIT SUB
  121.     END IF
  122.     
  123.  
  124.  
  125.  
  126.     END SUB
  127.  
  128.     SUB DOCLIP (RET$, MAXX, MAXY)
  129.  
  130.     '*************************************************************************
  131.     '* SET UP AND SHOW THE THE TITLE
  132.     '*************************************************************************
  133.     TITLE$ = "DEMO 2: Clipping capability"
  134.     PALSET PAL2, 0, 255
  135.    
  136.     '*************************************************************************
  137.     '* SET UP THE WINDOWS
  138.     '*************************************************************************
  139.     FILLSCREEN (0)
  140.     SETVIEW 0, 0, MAXX, MAXY
  141.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  142.     A$ = "All primatives automaticlly clip"
  143.     DRWSTRING 1, 7, 0, A$, 10, 16
  144.  
  145.     WDTH = (MAXX + 1) / 2.25
  146.     SPCINGX = ((MAXX + 1) - WDTH * 2) / 3
  147.     HGTH = (MAXY + 1 - 35) / 2.25
  148.     SPCINGY = ((MAXY + 1 - 35) - HGTH * 2) / 3
  149.     XINC = WDTH * 1.5
  150.     YINC = HGTH * 1.5
  151.     XSUB = WDTH * .25
  152.     YSUB = HGTH * .25
  153.  
  154.  
  155.     B1X1 = SPCINGX
  156.     B1X2 = B1X1 + WDTH
  157.     B1Y1 = SPCINGY + 35
  158.     B1Y2 = B1Y1 + HGTH
  159.   
  160.     B2X2 = MAXX - SPCINGX
  161.     B2X1 = B2X2 - WDTH
  162.     B2Y1 = SPCINGY + 35
  163.     B2Y2 = B2Y1 + HGTH
  164.   
  165.     B3X2 = MAXX - SPCINGX
  166.     B3X1 = B3X2 - WDTH
  167.     B3Y2 = MAXY - SPCINGY
  168.     B3Y1 = B3Y2 - HGTH
  169.   
  170.     B4X1 = SPCINGX
  171.     B4X2 = B4X1 + WDTH
  172.     B4Y2 = MAXY - SPCINGY
  173.     B4Y1 = B4Y2 - HGTH
  174.  
  175.     DRWBOX 1, 15, B1X1, B1Y1, B1X2, B1Y2
  176.     DRWBOX 1, 15, B2X1, B2Y1, B2X2, B2Y2
  177.     DRWBOX 1, 15, B3X1, B3Y1, B3X2, B3Y2
  178.     DRWBOX 1, 15, B4X1, B4Y1, B4X2, B4Y2
  179.  
  180.     B1X1 = B1X1 + 1
  181.     B1Y1 = B1Y1 + 1
  182.     B1X2 = B1X2 - 1
  183.     B1Y2 = B1Y2 - 1
  184.   
  185.     B2X1 = B2X1 + 1
  186.     B2Y1 = B2Y1 + 1
  187.     B2X2 = B2X2 - 1
  188.     B2Y2 = B2Y2 - 1
  189.   
  190.     B3X1 = B3X1 + 1
  191.     B3Y1 = B3Y1 + 1
  192.     B3X2 = B3X2 - 1
  193.     B3Y2 = B3Y2 - 1
  194.  
  195.     B4X1 = B4X1 + 1
  196.     B4Y1 = B4Y1 + 1
  197.     B4X2 = B4X2 - 1
  198.     B4Y2 = B4Y2 - 1
  199.  
  200.     Colr = 1
  201.  
  202.     '*************************************************************************
  203.     '* SHOW THE CLIPPING
  204.     '*************************************************************************
  205.     FOR I = 0 TO MAXX \ 6
  206.         FOR J = 1 TO 4
  207.             SELECT CASE J
  208.                 CASE IS = 1
  209.                     SETVIEW B1X1, B1Y1, B1X2, B1Y2
  210.                     FOR K = 0 TO 4
  211.                         X = B1X1 + RND * XINC - XSUB
  212.                         Y = B1Y1 + RND * XINC - XSUB
  213.                         DRWPOINT 1, Colr, X, Y
  214.                         Colr = Colr + 1
  215.                         IF Colr > 15 THEN
  216.                             Colr = 1
  217.                         END IF
  218.                     NEXT K
  219.                 CASE IS = 2
  220.                     SETVIEW B2X1, B2Y1, B2X2, B2Y2
  221.                     X1 = B2X1 + RND * XINC - XSUB
  222.                     Y1 = B2Y1 + RND * XINC - XSUB
  223.                     X2 = B2X1 + RND * XINC - XSUB
  224.                     Y2 = B2Y1 + RND * XINC - XSUB
  225.                     DRWLINE 1, Colr, X1, Y1, X2, Y2
  226.                     Colr = Colr + 1
  227.                     IF Colr > 15 THEN
  228.                         Colr = 1
  229.                     END IF
  230.                 CASE IS = 3
  231.                     SETVIEW B3X1, B3Y1, B3X2, B3Y2
  232.                     X = B3X1 + RND * XINC - XSUB
  233.                     Y = B3Y1 + RND * XINC - XSUB
  234.                     RAD = RND * WDTH \ 2
  235.                     DRWCIRCLE 1, Colr, X, Y, RAD
  236.                     Colr = Colr + 1
  237.                     IF Colr > 15 THEN
  238.                         Colr = 1
  239.                     END IF
  240.                 CASE IS = 4
  241.                     SETVIEW B4X1, B4Y1, B4X2, B4Y2
  242.                     X = B4X1 + RND * XINC - XSUB
  243.                     Y = B4Y1 + RND * XINC - XSUB
  244.                     RADX = RND * WDTH \ 2
  245.                     RADY = RND * WDTH \ 2
  246.                     DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  247.                     Colr = Colr + 1
  248.                     IF Colr > 15 THEN
  249.                         Colr = 1
  250.                     END IF
  251.             END SELECT
  252.         NEXT J
  253.     NEXT I
  254.     SETVIEW 0, 0, MAXX, MAXY
  255.     GETKEY RET$
  256.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  257.         EXIT SUB
  258.     END IF
  259.   
  260.     END SUB
  261.  
  262.     SUB DOFILL (RET$, MAXX, MAXY)
  263.  
  264.     '*************************************************************************
  265.     '* SET UP THE TITLE
  266.     '*************************************************************************
  267.     TITLE$ = "DEMO 3: Filling functions"
  268.     PALSET PAL, 0, 255
  269.  
  270.     '*************************************************************************
  271.     '* SHOW SCREEN FILL
  272.     '*************************************************************************
  273.     FILLSCREEN (10)
  274.     SETVIEW 0, 0, MAXX, MAXY
  275.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  276.     A$ = "FILLSCREEN (Color)"
  277.     DRWSTRING 1, 7, 0, A$, 10, 16
  278.     GETKEY RET$
  279.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  280.         SETVIEW 0, 0, MAXX, MAXY
  281.         EXIT SUB
  282.     END IF
  283.   
  284.     '*************************************************************************
  285.     '* SET UP WINDOWS AND SHOW VIEWPORT FILL
  286.     '*************************************************************************
  287.     FILLSCREEN (0)
  288.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  289.     A$ = "FILLVIEW (Color)"
  290.     DRWSTRING 1, 7, 0, A$, 10, 16
  291.   
  292.     WDTH = (MAXX + 1) / 2.25
  293.     SPCINGX = ((MAXX + 1) - WDTH * 2) / 3
  294.     HGTH = (MAXY + 1 - 35) / 2.25
  295.     SPCINGY = ((MAXY + 1 - 35) - HGTH * 2) / 3
  296.     XINC = WDTH * 1.5
  297.     YINC = HGTH * 1.5
  298.     XSUB = WDTH * .25
  299.     YSUB = HGTH * .25
  300.   
  301.     B1X1 = SPCINGX
  302.     B1X2 = B1X1 + WDTH
  303.     B1Y1 = SPCINGY + 35
  304.     B1Y2 = B1Y1 + HGTH
  305.  
  306.     B2X2 = MAXX - SPCINGX
  307.     B2X1 = B2X2 - WDTH
  308.     B2Y1 = SPCINGY + 35
  309.     B2Y2 = B2Y1 + HGTH
  310.  
  311.     B3X2 = MAXX - SPCINGX
  312.     B3X1 = B3X2 - WDTH
  313.     B3Y2 = MAXY - SPCINGY
  314.     B3Y1 = B3Y2 - HGTH
  315.  
  316.     B4X1 = SPCINGX
  317.     B4X2 = B4X1 + WDTH
  318.     B4Y2 = MAXY - SPCINGY
  319.     B4Y1 = B4Y2 - HGTH
  320.  
  321.     DRWBOX 1, 15, B1X1, B1Y1, B1X2, B1Y2
  322.     DRWBOX 1, 15, B2X1, B2Y1, B2X2, B2Y2
  323.     DRWBOX 1, 15, B3X1, B3Y1, B3X2, B3Y2
  324.     DRWBOX 1, 15, B4X1, B4Y1, B4X2, B4Y2
  325.  
  326.     B1X1 = B1X1 + 1
  327.     B1Y1 = B1Y1 + 1
  328.     B1X2 = B1X2 - 1
  329.     B1Y2 = B1Y2 - 1
  330.  
  331.     B2X1 = B2X1 + 1
  332.     B2Y1 = B2Y1 + 1
  333.     B2X2 = B2X2 - 1
  334.     B2Y2 = B2Y2 - 1
  335.  
  336.     B3X1 = B3X1 + 1
  337.     B3Y1 = B3Y1 + 1
  338.     B3X2 = B3X2 - 1
  339.     B3Y2 = B3Y2 - 1
  340.  
  341.     B4X1 = B4X1 + 1
  342.     B4Y1 = B4Y1 + 1
  343.     B4X2 = B4X2 - 1
  344.     B4Y2 = B4Y2 - 1
  345.  
  346.     GETKEY RET$
  347.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  348.         SETVIEW 0, 0, MAXX, MAXY
  349.         EXIT SUB
  350.     END IF
  351.   
  352.     SETVIEW B1X1, B1Y1, B1X2, B1Y2
  353.     FILLVIEW (10)
  354.     SETVIEW B2X1, B2Y1, B2X2, B2Y2
  355.     FILLVIEW (12)
  356.     SETVIEW B3X1, B3Y1, B3X2, B3Y2
  357.     FILLVIEW (13)
  358.     SETVIEW B4X1, B4Y1, B4X2, B4Y2
  359.     FILLVIEW (14)
  360.   
  361.     SETVIEW 0, 0, MAXX, MAXY
  362.     GETKEY RET$
  363.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  364.         SETVIEW 0, 0, MAXX, MAXY
  365.         EXIT SUB
  366.     END IF
  367.  
  368.     '*************************************************************************
  369.     '* SET UP WINDOW AND SHOW AREA FILL
  370.     '*************************************************************************
  371.     FILLSCREEN (0)
  372.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  373.     A$ = "FILLAREA (Xseed,Yseed,BrdrCol,FilCol)"
  374.     DRWSTRING 1, 7, 0, A$, 10, 16
  375.  
  376.     DRWBOX 1, 15, 5, 35, MAXX - 4, MAXY - 4
  377.     SETVIEW 6, 36, MAXX - 5, MAXY - 5
  378.  
  379.     Colr = 1
  380.     FOR I = 0 TO MAXX \ 10
  381.         X = 50 + RND * (MAXX - 50)
  382.         Y = 50 + RND * (MAXY - 50)
  383.         RADX = 2 + RND * MAXX \ 20
  384.         RADY = 2 + RND * MAXX \ 20
  385.         DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  386.         Colr = Colr + 1
  387.         IF Colr > 10 THEN
  388.             Colr = 1
  389.         END IF
  390.     NEXT I
  391.   
  392.     FOR I = 0 TO MAXX \ 15
  393.         X = 50 + RND * (MAXX - 50)
  394.         Y = 50 + RND * (MAXY - 50)
  395.         RADX = 2 + RND * MAXX \ 20
  396.         RADY = 2 + RND * MAXX \ 20
  397.         DRWELLIPSE 1, 12, X, Y, RADX, RADY
  398.     NEXT I
  399.  
  400.     GETKEY RET$
  401.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  402.         SETVIEW 0, 0, MAXX, MAXY
  403.         EXIT SUB
  404.     END IF
  405.  
  406.     FILLAREA 7, 37, 12, 10
  407.  
  408.     GETKEY RET$
  409.     SETVIEW 0, 0, MAXX, MAXY
  410.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  411.         EXIT SUB
  412.     END IF
  413.  
  414.     '*************************************************************************
  415.     '* SET UP WINDOW AND SHOW COLOR FILL
  416.     '*************************************************************************
  417.     FILLSCREEN (0)
  418.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  419.     A$ = "FILLCOLOR (Xseed,Yseed,OldCol,FilCol)"
  420.     DRWSTRING 1, 7, 0, A$, 10, 16
  421.  
  422.     DRWBOX 1, 15, 5, 35, MAXX - 4, MAXY - 4
  423.     SETVIEW 6, 36, MAXX - 5, MAXY - 5
  424.  
  425.     Colr = 1
  426.     FOR I = 0 TO MAXX \ 10
  427.         X = 50 + RND * (MAXX - 50)
  428.         Y = 50 + RND * (MAXY - 50)
  429.         RADX = 2 + RND * MAXX \ 20
  430.         RADY = 2 + RND * MAXX \ 20
  431.         DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  432.         Colr = Colr + 1
  433.         IF Colr > 10 THEN
  434.             Colr = 1
  435.         END IF
  436.     NEXT I
  437.    
  438.     FOR I = 0 TO MAXX \ 15
  439.         X = 50 + RND * (MAXX - 50)
  440.         Y = 50 + RND * (MAXY - 50)
  441.         RADX = 2 + RND * MAXX \ 20
  442.         RADY = 2 + RND * MAXX \ 20
  443.         DRWELLIPSE 1, 12, X, Y, RADX, RADY
  444.     NEXT I
  445.    
  446.     GETKEY RET$
  447.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  448.         SETVIEW 0, 0, MAXX, MAXY
  449.         EXIT SUB
  450.     END IF
  451.  
  452.     FILLCOLOR 7, 37, 0, 10
  453.   
  454.     SETVIEW 0, 0, MAXX, MAXY
  455.     GETKEY RET$
  456.  
  457.     END SUB
  458.  
  459.     SUB DOPAL (RET$, MAXX, MAXY)
  460.  
  461.     '*************************************************************************
  462.     '* SET UP THE TITLE
  463.     '*************************************************************************
  464.     TITLE$ = "DEMO 4: Palette functions"
  465.     PALSET ORGPAL, 0, 255
  466.    
  467.     '*************************************************************************
  468.     '* SHOW PALETTE SET/GET
  469.     '*************************************************************************
  470.     FILLSCREEN (0)
  471.     SETVIEW 0, 0, MAXX, MAXY
  472.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  473.     A$ = "PALGET (Palette$,FirstColr,LastColr) PALSET (Palette$,FirtColr,LastColr)"
  474.     DRWSTRING 1, 7, 0, A$, 10, 16
  475.     Colr = 16
  476.     X1 = 10
  477.     X2 = MAXX - 9
  478.     Y1 = 35
  479.     Y2 = MAXY - 9
  480.     I = 0
  481.     WHILE Y1 + I < Y2 - I
  482.         DRWBOX 1, Colr, X1 + I, Y1 + I, X2 - I, Y2 - I
  483.         Colr = Colr + 1
  484.         IF Colr > 255 THEN
  485.             Colr = 16
  486.         END IF
  487.         I = I + 1
  488.     WEND
  489.     GETKEY RET$
  490.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  491.         FILLSCREEN (0)
  492.         PALSET PAL, 16, 255
  493.         SETVIEW 0, 0, MAXX, MAXY
  494.         EXIT SUB
  495.     END IF
  496.     PALSET PAL, 16, 255
  497.   
  498.     '*************************************************************************
  499.     '* SHOW PALETTE AUTO FADE OUT/IN
  500.     '*************************************************************************
  501.     A$ = "PALIOAUTO (Palette$,FirstColr,LastColr,Speed)                           "
  502.     DRWSTRING 1, 7, 0, A$, 10, 16
  503.     GETKEY RET$
  504.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  505.         SETVIEW 0, 0, MAXX, MAXY
  506.         EXIT SUB
  507.     END IF
  508.     PALIOAUTO PAL, 16, 255, -2
  509.     PALIOAUTO PAL, 16, 255, 2
  510.  
  511.     '*************************************************************************
  512.     '* SHOW PALETTE AUTO FADE TO
  513.     '*************************************************************************
  514.     A$ = "PALCHGAUTO (Palette$,NewPalette$,FirstColr,LastColr,Speed)"
  515.     DRWSTRING 1, 7, 0, A$, 10, 16
  516.     GETKEY RET$
  517.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  518.         SETVIEW 0, 0, MAXX, MAXY
  519.         EXIT SUB
  520.     END IF
  521.     PALCHGAUTO PAL, PAL2, 16, 255, 2
  522.     PALCHGAUTO PAL2, PAL, 16, 255, 2
  523.   
  524.     '*************************************************************************
  525.     '* SHOW PALETTE ROTATE
  526.     '*************************************************************************
  527.     A$ = "PALROTATE (Palette$,FirstColr,LastColr,Shift)             "
  528.     DRWSTRING 1, 7, 0, A$, 10, 16
  529.     GETKEY RET$
  530.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  531.         SETVIEW 0, 0, MAXX, MAXY
  532.         EXIT SUB
  533.     END IF
  534.     FOR I = 0 TO 240
  535.         PALROTATE PAL, 16, 255, 2
  536.         PALGET PAL, 16, 255
  537.     NEXT I
  538.     FOR I = 0 TO 120
  539.         PALROTATE PAL, 16, 255, -8
  540.         PALGET PAL, 16, 255
  541.     NEXT I
  542.     GETKEY RET$
  543.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  544.         SETVIEW 0, 0, MAXX, MAXY
  545.         EXIT SUB
  546.     END IF
  547.  
  548.     END SUB
  549.  
  550.     SUB DOPRIMS (RET$, MAXX, MAXY)
  551.   
  552.     '*************************************************************************
  553.     '* SET UP THE THE TITLE
  554.     '*************************************************************************
  555.     TITLE$ = "DEMO 1: Primatives"
  556.     PALSET PAL, 0, 255
  557.   
  558.     '*************************************************************************
  559.     '* DRAW SOME POINTS
  560.     '*************************************************************************
  561.     FILLSCREEN (0)
  562.     SETVIEW 0, 0, MAXX, MAXY
  563.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  564.     A$ = "DRWPOINT (Mode,Color,X1,Y1,X2,Y2)"
  565.     DRWSTRING 1, 7, 0, A$, 10, 18
  566.     SETVIEW 0, 32, MAXX, MAXY
  567.     Colr = 1
  568.     NUMOF = MAXX * 2
  569.     FOR A = 0 TO NUMOF
  570.         X1 = RND * MAXX
  571.         Y1 = RND * MAXY
  572.         DRWPOINT 1, Colr, X1, Y1
  573.         Colr = Colr + 1
  574.         IF Colr > 15 THEN
  575.             Colr = 1
  576.         END IF
  577.     NEXT A
  578.     GETKEY RET$
  579.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  580.         SETVIEW 0, 0, MAXX, MAXY
  581.         EXIT SUB
  582.     END IF
  583.   
  584.     '*************************************************************************
  585.     '* DRAW SOME LINES
  586.     '*************************************************************************
  587.     SETVIEW 0, 0, MAXX, MAXY
  588.     FILLSCREEN (0)
  589.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  590.     A$ = "DRWLINE (Mode,Color,X1,Y1,X2,Y2)"
  591.     DRWSTRING 1, 7, 0, A$, 10, 18
  592.     SETVIEW 0, 32, MAXX, MAXY
  593.     NUMOF = MAXX \ 6
  594.     FOR A = 0 TO NUMOF
  595.         X1 = RND * MAXX
  596.         Y1 = RND * MAXY
  597.         X2 = RND * MAXX
  598.         Y2 = RND * MAXY
  599.         DRWLINE 1, Colr, X1, Y1, X2, Y2
  600.         Colr = Colr + 1
  601.         IF Colr > 15 THEN
  602.             Colr = 1
  603.         END IF
  604.     NEXT A
  605.     GETKEY RET$
  606.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  607.         SETVIEW 0, 0, MAXX, MAXY
  608.         EXIT SUB
  609.     END IF
  610.  
  611.     '*************************************************************************
  612.     '* DRAW SOME BOXES
  613.     '*************************************************************************
  614.     SETVIEW 0, 0, MAXX, MAXY
  615.     FILLSCREEN (0)
  616.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  617.     A$ = "DRWBOX (Mode,Color,X1,Y1,X2,Y2)"
  618.     DRWSTRING 1, 7, 0, A$, 10, 18
  619.     SETVIEW 0, 32, MAXX, MAXY
  620.     NUMOF = MAXX \ 10
  621.     FOR A = 0 TO NUMOF
  622.         X1 = RND * MAXX
  623.         Y1 = RND * MAXY
  624.         X2 = RND * MAXX
  625.         Y2 = RND * MAXY
  626.         DRWBOX 1, Colr, X1, Y1, X2, Y2
  627.         Colr = Colr + 1
  628.         IF Colr > 15 THEN
  629.             Colr = 1
  630.         END IF
  631.     NEXT A
  632.     GETKEY RET$
  633.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  634.         SETVIEW 0, 0, MAXX, MAXY
  635.         EXIT SUB
  636.     END IF
  637.  
  638.     '*************************************************************************
  639.     '* DRAW SOME CIRCLES
  640.     '*************************************************************************
  641.     SETVIEW 0, 0, MAXX, MAXY
  642.     FILLSCREEN (0)
  643.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  644.     A$ = "DRWCIRCLE (Mode,Color,Cx,Cy,Radius)"
  645.     DRWSTRING 1, 7, 0, A$, 10, 18
  646.     SETVIEW 0, 32, MAXX, MAXY
  647.     NUMOF = MAXX \ 20
  648.     MAXRAD = MAXX \ 2
  649.     FOR A = 0 TO NUMOF
  650.         X = RND * MAXX
  651.         Y = RND * MAXY
  652.         RAD = RND * MAXRAD
  653.         DRWCIRCLE 1, Colr, X, Y, RAD
  654.         Colr = Colr + 1
  655.         IF Colr > 15 THEN
  656.             Colr = 1
  657.         END IF
  658.     NEXT A
  659.     GETKEY RET$
  660.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  661.         SETVIEW 0, 0, MAXX, MAXY
  662.         EXIT SUB
  663.     END IF
  664.  
  665.     '*************************************************************************
  666.     '* DRAW SOME ELLIPSES
  667.     '*************************************************************************
  668.     SETVIEW 0, 0, MAXX, MAXY
  669.     FILLSCREEN (0)
  670.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  671.     A$ = "DRWELLIPSE (Mode,Color,Cx,Cy,RadiusX,RadiusY)"
  672.     DRWSTRING 1, 7, 0, A$, 10, 18
  673.     SETVIEW 0, 32, MAXX, MAXY
  674.     NUMOF = MAXX \ 20
  675.     MAXRAD = MAXX \ 2
  676.     FOR A = 0 TO NUMOF
  677.         X = RND * MAXX
  678.         Y = RND * MAXY + 35
  679.         RADX = RND * MAXRAD
  680.         RADY = RND * MAXRAD
  681.         DRWELLIPSE 1, Colr, X, Y, RADX, RADY
  682.         Colr = Colr + 1
  683.         IF Colr > 15 THEN
  684.             Colr = 1
  685.         END IF
  686.     NEXT A
  687.     SETVIEW 0, 0, MAXX, MAXY
  688.     GETKEY RET$
  689.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  690.         EXIT SUB
  691.     END IF
  692.   
  693.     END SUB
  694.  
  695.     SUB DOSCROLL (RET$, MAXX, MAXY)
  696.  
  697.     
  698.     '*************************************************************************
  699.     '* SET UP THE TITLE
  700.     '*************************************************************************
  701.     TITLE$ = "DEMO 7: Scroll functions"
  702.     PALSET PAL, 0, 255
  703.     FILLSCREEN (0)
  704.     SETVIEW 0, 0, MAXX, MAXY
  705.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  706.    
  707.     SPCNG = (MAXY - 32) \ 5
  708.     SKIP = (INT((MAXX + 1) / 320 + .9) * 2) - 1
  709.     NUM = SPCNG / 2 / SKIP
  710.     IF SPCNG / 2 <> INT(SPCNG / 2) THEN
  711.         SPCNG = SPCNG + 1
  712.     END IF
  713.     X1 = ((MAXX + 1) \ 2) - SPCNG
  714.     Y1 = (((MAXY + 1 - 32) \ 2) + 32) - SPCNG
  715.     X2 = ((MAXX + 1) \ 2) + SPCNG
  716.     Y2 = (((MAXY + 1 - 32) \ 2) + 32) + SPCNG
  717.  
  718.     DRWBOX 1, 12, X1, Y1, X2, Y2
  719.     X1 = X1 + 1
  720.     Y1 = Y1 + 1
  721.     X2 = X2 - 1
  722.     Y2 = Y2 - 1
  723.     Colr = 16
  724.     TEXT$ = "TEXT text TEXT"
  725.    
  726.     '*************************************************************************
  727.     '* SHOW SCROLLUP
  728.     '*************************************************************************
  729.     SETVIEW 0, 0, MAXX, MAXY
  730.     A$ = "SCROLLUP (X1,Y1,X2,Y2,NumLines,FillColr)"
  731.     DRWSTRING 1, 7, 0, A$, 10, 16
  732.     SETVIEW X1, Y1, X2, Y2
  733.     FILLVIEW (0)
  734.     NUMOF = MAXX \ 10
  735.     FOR A = 0 TO NUMOF
  736.         X = RND * MAXX
  737.         Y = RND * MAXY
  738.         I = RND * MAXX
  739.         J = RND * MAXY
  740.         DRWLINE 1, Colr, X, Y, I, J
  741.         Colr = Colr + 3
  742.         IF Colr > 255 THEN
  743.             Colr = 16
  744.         END IF
  745.     NEXT A
  746.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  747.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  748.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  749.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  750.     GETKEY RET$
  751.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  752.         SETVIEW 0, 0, MAXX, MAXY
  753.         EXIT SUB
  754.     END IF
  755.     FOR A = 0 TO NUM
  756.         SCROLLUP X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  757.     NEXT A
  758.    
  759.     '*************************************************************************
  760.     '* SHOW SCROLLLT
  761.     '*************************************************************************
  762.     SETVIEW 0, 0, MAXX, MAXY
  763.     A$ = "SCROLLLT (X1,Y1,X2,Y2,NumLines,FillColr)"
  764.     DRWSTRING 1, 7, 0, A$, 10, 16
  765.     SETVIEW X1, Y1, X2, Y2
  766.     FILLVIEW (0)
  767.     NUMOF = MAXX \ 10
  768.     FOR A = 0 TO NUMOF
  769.         X = RND * MAXX
  770.         Y = RND * MAXY
  771.         I = RND * MAXX
  772.         J = RND * MAXY
  773.         DRWLINE 1, Colr, X, Y, I, J
  774.         Colr = Colr + 3
  775.         IF Colr > 255 THEN
  776.             Colr = 16
  777.         END IF
  778.     NEXT A
  779.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  780.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  781.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  782.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  783.     GETKEY RET$
  784.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  785.         SETVIEW 0, 0, MAXX, MAXY
  786.         EXIT SUB
  787.     END IF
  788.     FOR A = 0 TO NUM
  789.         SCROLLLT X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  790.     NEXT A
  791.    
  792.     '*************************************************************************
  793.     '* SHOW SCROLLDN
  794.     '*************************************************************************
  795.     SETVIEW 0, 0, MAXX, MAXY
  796.     A$ = "SCROLLDN (X1,Y1,X2,Y2,NumLines,FillColr)"
  797.     DRWSTRING 1, 7, 0, A$, 10, 16
  798.     SETVIEW X1, Y1, X2, Y2
  799.     FILLVIEW (0)
  800.     NUMOF = MAXX \ 10
  801.     FOR A = 0 TO NUMOF
  802.         X = RND * MAXX
  803.         Y = RND * MAXY
  804.         I = RND * MAXX
  805.         J = RND * MAXY
  806.         DRWLINE 1, Colr, X, Y, I, J
  807.         Colr = Colr + 3
  808.         IF Colr > 255 THEN
  809.             Colr = 16
  810.         END IF
  811.     NEXT A
  812.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  813.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  814.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  815.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  816.     GETKEY RET$
  817.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  818.         SETVIEW 0, 0, MAXX, MAXY
  819.         EXIT SUB
  820.     END IF
  821.     TIM! = TIMER
  822.     FOR A = 0 TO NUM
  823.         SCROLLDN X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  824.     NEXT A
  825.     TIM3! = TIMER - TIM!
  826.   
  827.     '*************************************************************************
  828.     '* SHOW SCROLLRT
  829.     '*************************************************************************
  830.     SETVIEW 0, 0, MAXX, MAXY
  831.     A$ = "SCROLLRT (X1,Y1,X2,Y2,NumLines,FillColr)"
  832.     DRWSTRING 1, 7, 0, A$, 10, 16
  833.     SETVIEW X1, Y1, X2, Y2
  834.     FILLVIEW (0)
  835.     NUMOF = MAXX \ 10
  836.     FOR A = 0 TO NUMOF
  837.         X = RND * MAXX
  838.         Y = RND * MAXY
  839.         I = RND * MAXX
  840.         J = RND * MAXY
  841.         DRWLINE 1, Colr, X, Y, I, J
  842.         Colr = Colr + 3
  843.         IF Colr > 255 THEN
  844.             Colr = 16
  845.         END IF
  846.     NEXT A
  847.     DRWSTRING 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  848.     DRWSTRINGLT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  849.     DRWSTRINGDN 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  850.     DRWSTRINGRT 1, 7, 0, TEXT$, X1 + SPCNG, Y1 + SPCNG
  851.     GETKEY RET$
  852.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  853.         SETVIEW 0, 0, MAXX, MAXY
  854.         EXIT SUB
  855.     END IF
  856.     FOR A = 0 TO NUM
  857.         SCROLLRT X1, Y1, X2, Y2, SKIP, 0   '* HERE IT IS!
  858.     NEXT A
  859.    
  860.     GETKEY RET$
  861.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  862.         SETVIEW 0, 0, MAXX, MAXY
  863.         EXIT SUB
  864.     END IF
  865.  
  866.     END SUB
  867.  
  868.     SUB DOTEXT (RET$, MAXX, MAXY)
  869.  
  870.     '*************************************************************************
  871.     '* SET UP THE TITLE
  872.     '*************************************************************************
  873.     TITLE$ = "DEMO 6: Text functions"
  874.     PALSET PAL, 0, 255
  875.  
  876.     '*************************************************************************
  877.     '* SHOW ALTERNATE PRINT DIRECTIONS
  878.     '*************************************************************************
  879.     
  880.     FILLSCREEN (0)
  881.     SETVIEW 0, 0, MAXX, MAXY
  882.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  883.     A$ = "DRWSTRING(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  884.     DRWSTRING 1, 7, 0, A$, 10, 16
  885.     SETVIEW 0, 32, MAXX, MAXY
  886.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  887.     Colr = 16
  888.     FOR Y = 32 TO MAXY STEP 20
  889.         DRWSTRING 1, Colr, 0, A$, 0, Y
  890.         Colr = Colr + 5
  891.         IF Colr > 255 THEN
  892.             Colr = 16
  893.         END IF
  894.     NEXT Y
  895.     GETKEY RET$
  896.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  897.         SETVIEW 0, 0, MAXX, MAXY
  898.         FILLSCREEN (0)
  899.         EXIT SUB
  900.     END IF
  901.   
  902.     FILLVIEW (0)
  903.     SETVIEW 0, 0, MAXX, MAXY
  904.     A$ = "DRWSTRINGLT(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  905.     DRWSTRING 1, 7, 0, A$, 10, 16
  906.     SETVIEW 0, 32, MAXX, MAXY
  907.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  908.     FOR X = 0 TO MAXX STEP 20
  909.         DRWSTRINGLT 1, Colr, 0, A$, X, MAXY
  910.         Colr = Colr + 5
  911.         IF Colr > 255 THEN
  912.             Colr = 16
  913.         END IF
  914.     NEXT X
  915.     GETKEY RET$
  916.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  917.         SETVIEW 0, 0, MAXX, MAXY
  918.         FILLSCREEN (0)
  919.         EXIT SUB
  920.     END IF
  921.  
  922.     FILLVIEW (0)
  923.     SETVIEW 0, 0, MAXX, MAXY
  924.     A$ = "DRWSTRINGDN(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  925.     DRWSTRING 1, 7, 0, A$, 10, 16
  926.     SETVIEW 0, 32, MAXX, MAXY
  927.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  928.     Colr = 16
  929.     FOR Y = MAXY TO 32 STEP -20
  930.         DRWSTRINGDN 1, Colr, 0, A$, MAXX, Y
  931.         Colr = Colr + 5
  932.         IF Colr > 255 THEN
  933.             Colr = 16
  934.         END IF
  935.     NEXT Y
  936.     GETKEY RET$
  937.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  938.         SETVIEW 0, 0, MAXX, MAXY
  939.         FILLSCREEN (0)
  940.         EXIT SUB
  941.     END IF
  942.               
  943.     FILLVIEW (0)
  944.     SETVIEW 0, 0, MAXX, MAXY
  945.     A$ = "DRWSTRINGRT(Mode,ForeGndColr,BackGndColr,Text$,X,Y)"
  946.     DRWSTRING 1, 7, 0, A$, 10, 16
  947.     SETVIEW 0, 32, MAXX, MAXY
  948.     A$ = "The Quick Brown Fox Jumped Over The Lazy Dog's Back! 0123456789"
  949.     FOR X = MAXX TO 0 STEP -20
  950.         DRWSTRINGRT 1, Colr, 0, A$, X, 32
  951.         Colr = Colr + 5
  952.         IF Colr > 255 THEN
  953.             Colr = 16
  954.         END IF
  955.     NEXT X
  956.     GETKEY RET$
  957.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  958.         SETVIEW 0, 0, MAXX, MAXY
  959.         FILLSCREEN (0)
  960.         EXIT SUB
  961.     END IF
  962.        
  963.     END SUB
  964.  
  965.