DECLARE SUB paletteTrans (target() AS INTEGER, duration AS SINGLE)
DECLARE SUB paletteGet (array() AS INTEGER)
DECLARE SUB paletteSet (array() AS INTEGER)
DECLARE SUB toneGrayscale (array() AS INTEGER)
DECLARE SUB toneSepia (array() AS INTEGER)

CONST DAC.PELMask = &H3C6         ' DAC (Digital/Analog Converter) PEL Mask Register
CONST DAC.READ = &H3C7            ' DAC Read Port/DAC State Register
CONST DAC.WRITE = &H3C8           ' DAC Write Port/DAC State Register
CONST DAC.DATA = &H3C9            ' DAC Data Port

' Palette buffer
DIM clr(0 TO 767) AS INTEGER
DIM ini(0 TO 767) AS INTEGER

' Enter Mode 13 (320x200, 256 colors)
SCREEN 13

' Display the whole color palette
FOR y% = 0 TO 15
  FOR x% = 0 TO 15
    LINE (x% * 10, y% * 10)-STEP(9, 9), x% + (y% * 16), BF
  NEXT x%
NEXT y%

paletteGet ini()       ' get palette

' Wait for user input
COLOR 15: LOCATE 3, 25: PRINT "Press a key - 1": SLEEP
paletteGet clr()       ' get palette
toneSepia clr()        ' modify
paletteTrans clr(), 3  ' gradually change to sepia

' Wait for user input
COLOR 15: LOCATE 3, 25: PRINT "Press a key - 2": SLEEP
paletteGet clr()       ' get palette
toneGrayscale clr()    ' modify
paletteTrans clr(), 3  ' gradually change to Grayscale

' Wait for user input
COLOR 15: LOCATE 3, 25: PRINT "Press a key - 3": SLEEP
for i% = 0 to 767: clr(i%) = 0: next i%
paletteTrans ini(), 3  ' gradually change back to normal
paletteTrans clr(), 3  ' gradually fade out

' Read original palette, {array} must be (0 to 767)
SUB paletteGet (array() AS INTEGER)
  OUT DAC.PELMask, &HFF                        ' Mask all registers
  OUT DAC.READ, 0                              ' Select first attribute
  FOR i% = 0 TO 767                            ' Read all 768 components
    array(i%) = INP(DAC.DATA)
  NEXT i%
END SUB

' Set palette, {array} must be (0 to 767)
SUB paletteSet (array() AS INTEGER)
  OUT DAC.PELMask, &HFF                        ' Mask all registers
  OUT DAC.WRITE, 0                             ' Select first attribute
  FOR i% = 0 TO 767                            ' Set all 768 components
    OUT DAC.DATA, array(i%)
  NEXT i%
END SUB

' Transition from current palette to target palette
SUB paletteTrans (target() AS INTEGER, duration AS SINGLE)
  DIM source(0 TO 767) AS INTEGER
  DIM starts AS SINGLE, grad AS SINGLE

  paletteGet source()                          ' Capture current palette
  FOR i% = 0 TO 767                            ' and compute difference
    target(i%) = target(i%) - source(i%)       ' (delta) between source
  NEXT i%                                      ' and target.

  starts = TIMER                               ' Get current time
  OUT DAC.PELMask, &HFF                        ' Mask all registers
  OUT DAC.WRITE, 0                             ' Select first attribute
  DO
    grad = (TIMER - starts) / duration         ' Change for this frame
    IF (grad > 1) THEN grad = 1                ' Cap change
    FOR i% = 0 TO 767
      OUT &H3C9, source(i%) + (target(i%) * grad)
    NEXT i%
  LOOP WHILE (grad < 1)
END SUB

' Convert palette to Grayscale
SUB toneGrayscale (array() AS INTEGER)
  DIM grey AS INTEGER

  FOR i% = 0 TO 767 STEP 3
    grey = array(i%) * .299 + array(i% + 1) * .587 + array(i% + 2) * .114
    array(i%) = grey
    array(i% + 1) = grey
    array(i% + 2) = grey
  NEXT i%
END SUB

' Convert palette to sepia
SUB toneSepia (array() AS INTEGER)
  DIM r AS INTEGER, g AS INTEGER, b AS INTEGER

  FOR i% = 0 TO 767 STEP 3
    r = array(i%) * .393 + array(i% + 1) * .769 + array(i% + 2) * .189
    g = array(i%) * .349 + array(i% + 1) * .686 + array(i% + 2) * .168
    b = array(i%) * .272 + array(i% + 1) * .534 + array(i% + 2) * .131
    IF (r > 63) THEN array(i%) = 63 ELSE array(i%) = r
    IF (g > 63) THEN array(i% + 1) = 63 ELSE array(i% + 1) = g
    IF (b > 63) THEN array(i% + 2) = 63 ELSE array(i% + 2) = b
  NEXT i%
END SUB