home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / grap / util / 021 / svgamod1.bas < prev    next >
BASIC Source File  |  1993-06-11  |  29KB  |  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.     '**************************************