DECLARE FUNCTION transColor% (alpha AS SINGLE, c1 AS INTEGER, c2 AS INTEGER)

TYPE clrUDT
  R AS INTEGER
  G AS INTEGER
  B AS INTEGER
END TYPE

CONST DAC.PelMask = &H3C6
CONST DAC.READ = &H3C7
CONST DAC.DATA = &H3C9

CONST numColors = 16
CONST fullRange = 256

REDIM lookup(0 TO (numColors * numColors) - 1) AS INTEGER
DIM SHARED clrPal(0 TO fullRange - 1) AS clrUDT

SCREEN 13

' load current palette to structure
OUT DAC.PelMask, &HFF
OUT DAC.READ, 0
FOR i% = LBOUND(clrPal) TO UBOUND(clrPal)
  clrPal(i%).R = INP(DAC.DATA)
  clrPal(i%).G = INP(DAC.DATA)
  clrPal(i%).B = INP(DAC.DATA)
NEXT i%

' build lookup table
FOR b% = 0 TO numColors - 1
  FOR a% = 0 TO numColors - 1
    lookup(a% + b% * numColors) = transColor%(.5, a%, b%)
  NEXT a%
NEXT b%

' display lookup table (each cell will contain the blending result of color in column a% and color in row b%)
FOR b% = 0 TO numColors - 1
  PSET (b% + 2, 0), b%
  PSET (0, b% + 2), b%
  FOR a% = 0 TO numColors - 1
    PSET (a% + 2, b% + 2), lookup(a% + b% * numColors)
  NEXT a%
NEXT b%

' computes alpha-blending and finds closest existing attribute - uses taxicab distance
' which is faster but less accurate than dist = (delta.R ^ 2 + delta.G ^ 2 + delta.B ^ 2).
FUNCTION transColor% (alpha AS SINGLE, c1 AS INTEGER, c2 AS INTEGER)
  DIM blend AS clrUDT, dist AS INTEGER, temp AS INTEGER

  ' Quick bail
  IF ((c1 = c2) OR (alpha = 1)) THEN
    transColor% = c1
    EXIT FUNCTION
  END IF

  ' Get RGB value of alpha blending
  blend.R = alpha * clrPal(c1).R + (1 - alpha) * clrPal(c2).R
  blend.G = alpha * clrPal(c1).G + (1 - alpha) * clrPal(c2).G
  blend.B = alpha * clrPal(c1).B + (1 - alpha) * clrPal(c2).B

  ' Find index to closest RGB attribute
  dist = 255
  FOR i% = LBOUND(clrPal) TO UBOUND(clrPal)
    temp = ABS(blend.R - clrPal(i%).R) + ABS(blend.G - clrPal(i%).G) + ABS(blend.B - clrPal(i%).B)
    IF (temp < dist) THEN dist = temp: transColor% = i%
  NEXT i%
END FUNCTION