home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l170 / 3.ddi / SOURCE / PALETTE.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-09-18  |  1.7 KB  |  64 lines
  1. DECLARE SUB InitPalette ()
  2. DECLARE SUB ChangePalette ()
  3. DECLARE SUB DrawEllipses ()
  4. DEFINT A-Z
  5.  
  6. DIM SHARED PaletteArray(15)
  7.  
  8. SCREEN 8                 ' 640 x 200 resolution; 16 colors
  9.  
  10. InitPalette
  11. DrawEllipses
  12.  
  13. DO
  14.    ChangePalette
  15. LOOP WHILE INKEY$ = ""   ' Shift palette until key pressed
  16.  
  17. END
  18.  
  19. '
  20. ' ====================== ChangePalette =======================
  21. '    This procedure rotates the palette by one each time it
  22. '    is called.  For example, after the first call to
  23. '    ChangePalette, PaletteArray(1) = 2, PaletteArray(2) = 3,
  24. '    . . . , PaletteArray(14) = 15, and PaletteArray(15) = 1
  25. ' ============================================================
  26. '
  27. SUB ChangePalette STATIC
  28.    FOR I = 1 TO 15
  29.       PaletteArray(I) = (PaletteArray(I) MOD 15) + 1
  30.    NEXT I
  31.  
  32.    ' Shift the color displayed by each of the attributes from
  33.    ' one to fifteen:
  34.    PALETTE USING PaletteArray(0)
  35. END SUB
  36.  
  37. '
  38. ' ====================== DrawEllipses ========================
  39. '    This procedure draws fifteen concentric ellipses, and
  40. '    paints the interior of each with a different color.
  41. ' ============================================================
  42. '
  43. SUB DrawEllipses STATIC
  44.    CONST ASPECT = 1 / 3
  45.    FOR ColorVal = 15 TO 1 STEP -1
  46.       Radius = 20 * ColorVal
  47.       CIRCLE (320, 100), Radius, ColorVal, , , ASPECT
  48.       PAINT (320, 100), ColorVal
  49.    NEXT
  50. END SUB
  51.  
  52. '
  53. ' ======================= InitPalette ========================
  54. '    This procedure initializes the integer array used to
  55. '    change the palette.
  56. ' ============================================================
  57. '
  58. SUB InitPalette STATIC
  59.    FOR I = 0 TO 15
  60.       PaletteArray(I) = I
  61.    NEXT I
  62. END SUB
  63.  
  64.