'===========================================================================
' Subject: PALETTE ROTATION EXAMPLE          Date: 06-23-99 (09:42)       
' Author:  Matt Gulden                       Code: QB, QBasic, PDS        
' Origin:  www.karland.com/code/basic/     Packet: GRAPHICS.ABC
'===========================================================================
' PALROTAT.BAS
' by Matt Gulden
' http://www.thrillhaus.com/
' Real, fast, efficient palette rotation!
' This is the second version of this... In the first version, after a while
' on some computers the colors would get mixed up from reading all the values
' every time the colors rotate. In this version, they're only read when you
' call SavePalette() and stored in an array... They're rotated within the
' array. Also, the demo in this creates an optical illusion! Watch either
' of the rotations (up/down) about 10 feet away from the monitor for about a
' minute and then return to this screen and it will appear to be shrinking
' or expanding!

TYPE PalType
  Red AS INTEGER
  Green AS INTEGER
  Blue AS INTEGER
END TYPE

DEFINT A-Z
DECLARE SUB PalRotateUp (PALSTART, PALEND)
DECLARE SUB PalRotateDown (PALSTART, PALEND)
DECLARE SUB SavePalette ()
DIM SHARED PalColors(256) AS PalType

' Below is a little demo I made to show off the routines.
' You can snip anything from here on.

SCREEN 13

FOR NUM = 0 TO 63
  OUT &H3C8, NUM
  OUT &H3C9, NUM
  OUT &H3C9, NUM / 2
  OUT &H3C9, 0
NEXT
NUM2 = 63
FOR NUM = 64 TO 127
  OUT &H3C8, NUM
  OUT &H3C9, NUM2
  OUT &H3C9, NUM2 / 2
  OUT &H3C9, 0
  NUM2 = NUM2 - 1
NEXT
FOR NUM = 128 TO 191
  OUT &H3C8, NUM
  OUT &H3C9, NUM - 128
  OUT &H3C9, NUM - 128
  OUT &H3C9, 0
NEXT
NUM2 = 63
FOR NUM = 192 TO 255
  OUT &H3C8, NUM
  OUT &H3C9, NUM2
  OUT &H3C9, NUM2
  OUT &H3C9, 0
  NUM2 = NUM2 - 1
NEXT

FOR RADIUS = 0 TO 400
  COLOUR = COLOUR + 1
  IF COLOUR > 255 THEN COLOUR = 1
  CIRCLE (159, 99), RADIUS, COLOUR, , , .5
NEXT

SavePalette

WHILE INKEY$ = ""
  PalRotateUp 1, 255
WEND
WHILE INKEY$ = ""
  PalRotateDown 1, 255
WEND

SUB PalRotateDown (PALSTART, PALEND)
 
  FOR NUM = PALSTART TO PALEND
    OUT &H3C7, NUM
    IF NUM = PALSTART THEN
      PalColors(PALEND) = PalColors(PALSTART)
      OUT &H3C8, PALEND
      OUT &H3C9, PalColors(NUM).Red
      OUT &H3C9, PalColors(NUM).Green
      OUT &H3C9, PalColors(NUM).Blue
    ELSE
      PalColors(NUM - 1) = PalColors(NUM)
      OUT &H3C8, NUM - 1
      OUT &H3C9, PalColors(NUM).Red
      OUT &H3C9, PalColors(NUM).Green
      OUT &H3C9, PalColors(NUM).Blue
    END IF
  NEXT

END SUB

SUB PalRotateUp (PALSTART, PALEND)
 
  FOR NUM = PALEND TO PALSTART STEP -1
    IF NUM = PALEND THEN
      PalColors(PALSTART) = PalColors(PALEND)
      OUT &H3C8, PALSTART
      OUT &H3C9, PalColors(NUM).Red
      OUT &H3C9, PalColors(NUM).Green
      OUT &H3C9, PalColors(NUM).Blue
    ELSE
      PalColors(NUM + 1) = PalColors(NUM)
      OUT &H3C8, NUM + 1
      OUT &H3C9, PalColors(NUM).Red
      OUT &H3C9, PalColors(NUM).Green
      OUT &H3C9, PalColors(NUM).Blue
    END IF
  NEXT

END SUB

SUB SavePalette

  OUT &H3C6, &HFF

  FOR NUM = 0 TO 255
    OUT &H3C7, NUM
    PalColors(NUM).Red = INP(&H3C9)
    PalColors(NUM).Green = INP(&H3C9)
    PalColors(NUM).Blue = INP(&H3C9)
  NEXT

END SUB