home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / VGX3.ZIP / PALDEMO.BAS < prev    next >
BASIC Source File  |  1993-01-06  |  5KB  |  186 lines
  1. ' PALDEMO.BAS
  2. ' Demo of routines found in PALCALLS.BAS
  3.  
  4. ' VGX quicklibrary is REQUIRED
  5.  
  6. ' LOAD or MERGE PALCALLS.BAS into this program.
  7.  
  8. ' These palette routines will work ONLY in VGA SCREEN 12 mode!
  9.  
  10. DEFINT A-Z
  11.  
  12. DECLARE SUB VGXLoad (fil$, PalFlag%)
  13.  
  14.  
  15. DECLARE SUB GraySumCurrent ()      'gray-sums current palette
  16. DECLARE SUB graysumforced ()       'gray-sums using forced values
  17. DECLARE SUB BlankPal ()            'all colors = black (watch out!)
  18. DECLARE SUB ReadDACBLOCK (Pal%())  'get the current pallete into array
  19. DECLARE SUB SetDACBLOCK (Pal%())   'set the current pallete using array
  20. DECLARE SUB FadeIn (P%())
  21. DECLARE SUB FadeOut ()             'fades to attribute zero
  22. DECLARE SUB Fade2Black ()          'fades to black
  23. DECLARE SUB RotatePalette (StartPal%, EndPal%, speed%, Dir%) 'rotates the palette
  24. DECLARE FUNCTION VGAPALETTE& (R%, G%, B%)
  25.  
  26. DIM VGAPal(0 TO 23) AS INTEGER
  27. ' dimension a palette array to hold 48 bytes (you might want SHARED or
  28. ' COMMON palette arrays.)
  29.  
  30. DECLARE SUB PauseX (seconds!)
  31. '''''''''''''''
  32. SCREEN 12
  33.  
  34. y = 20
  35. kolor = 0
  36. FOR x = 0 TO 600 STEP 40
  37.    LINE (x, y)-(x + 36, y + 72), kolor, BF
  38.    kolor = kolor + 1
  39. NEXT x
  40.  
  41. ' First, let's load the current palette into VGApal
  42. ' so we can restore it later.
  43. CALL ReadDACBLOCK(VGAPal())   'get the current pallete into array
  44.  
  45. LOCATE 8, 1
  46. COLOR 1
  47. PRINT "First we will blank the palette.  All colors will equal zero but the"
  48. PRINT "screen data will remain.  Hit a key to blank, THEN HIT A KEY AGAIN..."
  49. DO: LOOP WHILE INKEY$ = ""
  50.  
  51. CALL BlankPal
  52. 'BE CAREFUL using BlankPal because the screen will STAY black until you
  53. 'restore a real palette.
  54.  
  55. DO: LOOP WHILE INKEY$ = ""
  56. CALL SetDACBLOCK(VGAPal())   'set the palette we stored above
  57.  
  58. COLOR 2: PRINT "Hit a key to continue..."
  59. DO: LOOP WHILE INKEY$ = ""
  60.  
  61. PALETTE 0, 30
  62. CALL ReadDACBLOCK(VGAPal())   'get the current pallete into array
  63.  
  64. COLOR 3
  65. PRINT "We have used PALETTE 0,30 to change the background color."
  66. PRINT "Now we will FADE to the BACKGROUND color and then fade back."
  67. PRINT "Hit a key to begin..."
  68. DO: LOOP WHILE INKEY$ = ""
  69.  
  70. CALL FadeOut
  71. CALL PauseX(1)
  72. CALL FadeIn(VGAPal())
  73.  
  74. PALETTE 4, 54
  75. COLOR 4
  76. PRINT "We will now fade to BLACK no matter what the background color is."
  77. PRINT "Hit a key to begin..."
  78. DO: LOOP WHILE INKEY$ = ""
  79.  
  80. CALL Fade2Black
  81. CALL PauseX(1)
  82. CALL FadeIn(VGAPal())
  83.  
  84. COLOR 5: PRINT "Hit a key to continue..."
  85. DO: LOOP WHILE INKEY$ = ""
  86. PALETTE 0, 0
  87. CALL ReadDACBLOCK(VGAPal())   'get the current pallete into array
  88.  
  89. COLOR 6
  90. PRINT "We will now ROTATE the palette in all colors."
  91. PRINT "Hit a key to begin then hit a key AGAIN to FINISH..."
  92. DO: LOOP WHILE INKEY$ = ""
  93.  
  94. Dir = 1
  95. StartPal% = 0: EndPal% = 15: speed% = 450
  96. CALL RotatePalette(StartPal%, EndPal%, speed%, Dir%) 'rotates the palette
  97.  
  98. Dir = 0
  99. COLOR 7: PRINT "We can go faster...and just rotate part of the pallete"
  100. StartPal% = 4: EndPal% = 13: speed% = 120
  101. CALL RotatePalette(StartPal%, EndPal%, speed%, Dir%) 'rotates the palette
  102.  
  103. Dir = 1
  104. COLOR 8: PRINT "We can go faster still!!!";
  105. StartPal% = 3: EndPal% = 13: speed% = 0
  106. CALL RotatePalette(StartPal%, EndPal%, speed%, Dir%) 'rotates the palette
  107.  
  108. ' Next we will show the gray values...
  109. COLOR 9
  110. PRINT "Hit any key to show the Gray-sum version of the current palette..."
  111. DO: LOOP WHILE INKEY$ = ""
  112.  
  113. CALL GraySumCurrent
  114.  
  115. 'restore the VGApal array palette
  116. COLOR 10: PRINT "Hit any key to restore the palette..."
  117. DO: LOOP WHILE INKEY$ = ""
  118.  
  119. CALL SetDACBLOCK(VGAPal())   'set the palette with array
  120.  
  121. ' Next we will show the FORCED gray values...
  122. COLOR 11
  123. PRINT "Hit any key to show the FORCED Gray-sum version of the current palette..."
  124. DO: LOOP WHILE INKEY$ = ""
  125.  
  126. CALL graysumforced
  127.  
  128. DO: LOOP WHILE INKEY$ = ""
  129. PALETTE 15, 63
  130. COLOR 15
  131. PRINT
  132. PRINT "This was a demo of PALCALLS.BAS, a group of nine VGA palette"
  133. PRINT "QB subprograms supplied free to registered users of VGX."
  134.  
  135. LINE (1, 1)-(639, 100), 0, BF
  136.  
  137. StartPal% = 1: EndPal% = 14: speed% = 50
  138. CALL RotatePalette(StartPal%, EndPal%, speed%, Dir%) 'rotates the palette
  139.  
  140. CLS
  141. CALL graysumforced
  142.  
  143. PALETTE 0, VGAPALETTE&(0, 0, 18)
  144. PALETTE 1, VGAPALETTE&(16, 16, 0)
  145. PALETTE 2, VGAPALETTE&(20, 28, 8)
  146. PALETTE 3, VGAPALETTE&(24, 32, 14)
  147. PALETTE 4, VGAPALETTE&(40, 34, 9)
  148. PALETTE 5, VGAPALETTE&(48, 38, 6)
  149. PALETTE 6, VGAPALETTE&(56, 50, 0)
  150. PALETTE 7, VGAPALETTE&(63, 63, 0)
  151. PALETTE 8, VGAPALETTE&(56, 56, 4)
  152. PALETTE 9, VGAPALETTE&(49, 49, 9)
  153. PALETTE 10, VGAPALETTE&(42, 42, 14)
  154. PALETTE 11, VGAPALETTE&(40, 30, 20)
  155. PALETTE 12, VGAPALETTE&(38, 24, 20)
  156. PALETTE 13, VGAPALETTE&(30, 20, 9)
  157. PALETTE 14, VGAPALETTE&(16, 10, 4)
  158. PALETTE 15, VGAPALETTE&(7, 7, 0)
  159.  
  160.  
  161. k = 1
  162. FOR x = 1 TO 340
  163.    CIRCLE (x * 1.3333333#, 240), x, k
  164.    k = k + 1: IF k = 16 THEN k = 1
  165. NEXT x
  166. CALL RotatePalette(1, 15, 0, 1) 'rotates the palette
  167.  
  168. ' load ARROW.VGX
  169. CALL VGXLoad("arrow", 3)
  170. RotatePalette 1, 15, 20, 0
  171.  
  172. FadeOut
  173.  
  174. CLS
  175. PALETTE
  176. SCREEN 0
  177. END
  178.  
  179. SUB PauseX (seconds!)
  180.  
  181. t2! = TIMER + seconds!
  182. DO: LOOP UNTIL TIMER > t2!
  183.  
  184. END SUB
  185.  
  186.