'' A bunch of routines to convert RGB to HSL, HSV, CMYK, and back. There's
'' also a couple of routines for grayscale and HEX notations conversion (it
'' supports 6, 3, 2 or 1-character codes.)

DECLARE SUB cRGB2CMYK (src AS ANY, dst AS ANY)
DECLARE SUB cRGB2HSL (src AS ANY, dst AS ANY)
DECLARE SUB cRGB2HSV (src AS ANY, dst AS ANY)
DECLARE SUB cRGB2HEX (src AS ANY, dst AS STRING, size AS INTEGER)
DECLARE SUB cRGB2Gray (src AS ANY, dst AS SINGLE)

DECLARE SUB cCMYK2RGB (src AS ANY, dst AS ANY)
DECLARE SUB cHSL2RGB (src AS ANY, dst AS ANY)
DECLARE SUB cHSV2RGB (src AS ANY, dst AS ANY)
DECLARE SUB cHEX2RGB (h AS STRING, dst AS ANY)
DECLARE SUB cGray2RGB (src AS SINGLE, dst AS ANY)

DECLARE SUB printRGB (rgb AS ANY, bits AS INTEGER)
DECLARE SUB printHSV (hsv AS ANY)
DECLARE SUB printHSL (hsl AS ANY)
DECLARE SUB printCMYK (cmyk AS ANY)

DECLARE FUNCTION utilCapInt% (i AS INTEGER, min AS INTEGER, max AS INTEGER)
DECLARE FUNCTION utilCapSng! (f AS SINGLE, min AS SINGLE, max AS SINGLE)
DECLARE FUNCTION utilModulo! (f AS SINGLE, o AS INTEGER)
DECLARE SUB utilNormalizeRGB (r AS INTEGER, g AS INTEGER, b AS INTEGER, bits AS INTEGER, dst AS ANY)
DECLARE SUB utilScaleRGB (src AS ANY, r AS INTEGER, g AS INTEGER, b AS INTEGER, bits AS INTEGER)

TYPE cRGB
	r AS SINGLE   ' red, floating-point value from 0 to 1
	g AS SINGLE   ' green, floating-point value from 0 to 1
	b AS SINGLE   ' blue, floating-point value from 0 to 1
END TYPE

TYPE cHSV
	h AS INTEGER  ' hue, expressed in degrees from 0 to 360
	s AS INTEGER  ' saturation, expressed in percent from 0 to 100
	v AS INTEGER  ' value, expressed in percent from 0 to 100
END TYPE

TYPE cHSL
	h AS INTEGER  ' hue, expressed in degrees from 0 to 360
	s AS INTEGER  ' saturation, expressed in percent from 0 to 100
	l AS INTEGER  ' lightness, expressed in percent from 0 to 100
END TYPE

TYPE cCMYK
	c AS INTEGER  ' cyan, expressed in percent from 0 to 100
	m AS INTEGER  ' magenta, expressed in percent from 0 to 100
	y AS INTEGER  ' yellow, expressed in percent from 0 to 100
	k AS INTEGER  ' black, expressed in percent from 0 to 100
END TYPE

DIM rgb AS cRGB, hsv AS cHSV
DIM hsl AS cHSL, cmyk AS cCMYK

'' Convert #FFCC11 (RGB: 255, 204, 17) into normalized RGB
cHEX2RGB "FFCC11", rgb

'' Display RGB values (8 bits per channel)
printRGB rgb, 8

'' Convert to Hue, Saturation, Value
PRINT : PRINT "RGB => HSV"
cRGB2HSV rgb, hsv
printHSV hsv

'' Convert to Hue, Saturation, Lightness
PRINT : PRINT "RGB => HSL"
cRGB2HSL rgb, hsl
printHSL hsl

'' Convert to Cyan, Magenta, Yellow, Black
PRINT : PRINT "RGB => CMYK"
cRGB2CMYK rgb, cmyk
printCMYK cmyk

'' Convert HSV to Red, Green, Blue
PRINT : PRINT "HSV => RGB"
cHSV2RGB hsv, rgb
printRGB rgb, 8

'' Convert HSL to Red, Green, Blue
PRINT : PRINT "HSL => RGB"
cHSL2RGB hsl, rgb
printRGB rgb, 8

'' Convert CMYK to Red, Green, Blue
PRINT : PRINT "CMYK => RGB"
cCMYK2RGB cmyk, rgb
printRGB rgb, 8

''
'' Convert CMYK (Cyan, Magenta, Yellow, Black) to normalized RGB (Red, Green,
'' Blue.)
''
SUB cCMYK2RGB (src AS cCMYK, dst AS cRGB)
	DIM c AS SINGLE, m AS SINGLE, y AS SINGLE, k AS SINGLE

	'' Cap CMYK values between 0 and 100, normalize
	c = utilCapInt%(src.c, 0, 100) / 100
	m = utilCapInt%(src.m, 0, 100) / 100
	y = utilCapInt%(src.y, 0, 100) / 100
	k = utilCapInt%(src.k, 0, 100) / 100

	'' Convert to RGB
	dst.r = (1 - c) * (1 - k)
	dst.g = (1 - m) * (1 - k)
	dst.b = (1 - y) * (1 - k)
END SUB

''
'' Converts hexadecimal notation to normalized RGB. This routines supports 8
'' and 4 bits per channel, color or grayscale, depending on the string length.
''
SUB cHEX2RGB (h AS STRING, dst AS cRGB)
	DIM r AS INTEGER, g AS INTEGER, b AS INTEGER

	SELECT CASE LEN(h)
	CASE 6
		'' RGB: 8 bits per channel
		r = VAL("&h" + MID$(h, 1, 2))
		g = VAL("&h" + MID$(h, 3, 2))
		b = VAL("&h" + MID$(h, 5, 2))

	CASE 3
		'' RGB: 4 bits per channel (convert to 8 bits)
		r = VAL("&h" + MID$(h, 1, 1)) * 17
		g = VAL("&h" + MID$(h, 2, 1)) * 17
		b = VAL("&h" + MID$(h, 3, 1)) * 17

	CASE 2
		'' Grayscale: 8 bits
		r = VAL("&h" + h)
		g = r
		b = r

	CASE 1
		'' Grayscale: 4 bits (convert to 8 bits)
		r = VAL("&h" + h) * 17
		g = r
		b = r
	END SELECT

	'' Normalize values
	utilNormalizeRGB r, g, b, 8, dst
END SUB

''
'' Convert HSL (Hue, Saturation, Lightness) to normalized RGB (Red, Green,
'' Blue.)
''
SUB cHSL2RGB (src AS cHSL, dst AS cRGB)
	DIM h AS SINGLE, s AS SINGLE, l AS SINGLE
	DIM x AS SINGLE, c AS SINGLE, m AS SINGLE
	DIM r AS SINGLE, g AS SINGLE, b AS SINGLE

	'' Cap source values
	h = utilCapInt%(src.h, 0, 359) / 60
	s = utilCapInt%(src.s, 0, 100) / 100
	l = utilCapInt%(src.l, 0, 100) / 100

	c = (1 - ABS(2 * l - 1)) * s
	x = c * (1 - ABS(utilModulo!(h, 2) - 1))

	IF (h < 1) THEN
		r = c
		g = x
	ELSEIF (h < 2) THEN
		r = x
		g = c
	ELSEIF (h < 3) THEN
		g = c
		b = x
	ELSEIF (h < 4) THEN
		g = x
		b = c
	ELSEIF (h < 5) THEN
		r = x
		b = c
	ELSE
		r = c
		b = x
	END IF

	m = l - c / 2

	dst.r = r + m
	dst.g = g + m
	dst.b = b + m
END SUB

''
'' Convert HSV (Hue, Saturation, Value) to normalized RGB (Red, Green, Blue.)
''
SUB cHSV2RGB (src AS cHSV, dst AS cRGB)
	DIM h AS SINGLE, s AS SINGLE, v AS SINGLE
	DIM x AS SINGLE, c AS SINGLE, m AS SINGLE
	DIM r AS SINGLE, g AS SINGLE, b AS SINGLE

	'' Cap source values
	h = utilCapInt%(src.h, 0, 359) / 60
	s = utilCapInt%(src.s, 0, 100) / 100
	v = utilCapInt%(src.v, 0, 100) / 100

	c = v * s
	x = c * (1 - ABS(utilModulo!(h, 2) - 1))

	IF (h < 1) THEN
		r = c
		g = x
	ELSEIF (h < 2) THEN
		r = x
		g = c
	ELSEIF (h < 3) THEN
		g = c
		b = x
	ELSEIF (h < 4) THEN
		g = x
		b = c
	ELSEIF (h < 5) THEN
		r = x
		b = c
	ELSE
		r = c
		b = x
	END IF

	m = v - c

	dst.r = r + m
	dst.g = g + m
	dst.b = b + m
END SUB

''
'' Convert RGB to grayscale.
''
SUB cRGB2Gray (src AS cRGB, dst AS SINGLE)
	dst = utilCapSng!(src.r, 0, 1) * .2989 + _
				utilCapSng!(src.g, 0, 1) * .5870 + _
				utilCapSng!(src.b, 0, 1) * .1140
END SUB

''
'' Convert grayscale to RGB.
''
SUB cGray2RGB (src AS SINGLE, dst AS cRGB)
	dst.r = utilCapSng!(src, 0, 1)
	dst.g = dst.r
	dst.b = dst.r
END SUB

''
'' Convert normalized RGB (Red, Green, Blue) to CMYK (Cyan, Magenta, Yellow,
'' Black.)
''
SUB cRGB2CMYK (src AS cRGB, dst AS cCMYK)
	DIM r AS SINGLE, g AS SINGLE, b AS SINGLE
	DIM c AS SINGLE, m AS SINGLE, y AS SINGLE, k AS SINGLE
	DIM max AS SINGLE

	'' Cap RGB values between 0 and 1 included
	r = utilCapSng!(src.r, 0, 1)
	g = utilCapSng!(src.g, 0, 1)
	b = utilCapSng!(src.b, 0, 1)

	'' Get max value
	max = r
	IF (g > max) THEN max = g
	IF (b > max) THEN max = b

	'' Black
	k = 1 - max

	'' Cyan, Magenta, Yellow
	IF (k <> 1) THEN
		c = (1 - r - k) / (1 - k)
		m = (1 - g - k) / (1 - k)
		y = (1 - b - k) / (1 - k)
	END IF

	'' output
	dst.c = INT(c * 100)
	dst.m = INT(m * 100)
	dst.y = INT(y * 100)
	dst.k = INT(k * 100)
END SUB

''
'' Convert RGB (Red, Green, Blue) to hexadecimal representation
''
SUB cRGB2HEX (src AS cRGB, dst AS STRING, size AS INTEGER)
	DIM r AS INTEGER, g AS INTEGER, b AS INTEGER
	DIM l AS SINGLE

	SELECT CASE size
	CASE 6
		'' RGB: 8 bits per channel
		utilScaleRGB src, r, g, b, 8
		dst = RIGHT$("0" + HEX$(r), 2) + _
					RIGHT$("0" + HEX$(g), 2) + _
					RIGHT$("0" + HEX$(b), 2)
	CASE 3
		'' RGB: 4 bits per channel
		utilScaleRGB src, r, g, b, 4
		dst = HEX$(r) + HEX$(g) + HEX$(b)
	CASE 2
		'' Grayscale: 8 bits per channel
		cRGB2Gray src, l
		dst = RIGHT$("0" + HEX$(INT(l * 255)), 2)
	CASE 1
		'' Grayscale: 4 bits per channel
		cRGB2Gray src, l
		dst = HEX$(INT(l * 15))
	END SELECT
END SUB

''
'' Convert normalized RGB (Red, Green, Blue) to HSL (Hue, Saturation,
'' Lightness.)
''
SUB cRGB2HSL (src AS cRGB, dst AS cHSL)
	DIM min AS SINGLE, max AS SINGLE, chroma AS SINGLE
	DIM r AS SINGLE, g AS SINGLE, b AS SINGLE
	DIM h AS SINGLE, s AS SINGLE, l AS SINGLE

	'' Cap RGB values between 0 and 1 included
	r = utilCapSng!(src.r, 0, 1)
	g = utilCapSng!(src.g, 0, 1)
	b = utilCapSng!(src.b, 0, 1)

	'' Find highest value
	max = r
	IF (g > max) THEN max = g
	IF (b > max) THEN max = b

	'' Find lowest value
	min = r
	IF (g < min) THEN min = g
	IF (b < min) THEN min = b

	'' Compute chroma
	chroma = max - min

	'' Hue
	SELECT CASE max
	CASE min
		h = 0
	CASE r
		h = ((g - b) / chroma)
	CASE g
		h = ((b - r) / chroma) + 2
	CASE ELSE
		h = ((r - g) / chroma) + 4
	END SELECT

	'' Lightness
	l = (max + min) / 2

	'' Saturation
	IF (max = 0) THEN
		s = 0
	ELSE
		s = chroma / (1 - ABS(2 * l - 1))
	END IF

	'' Hue is expressed in degrees, from 0 to 359
	dst.h = INT(utilModulo!(h, 6) * 60)
	IF (dst.h < 0) THEN dst.h = dst.h + 360
	'' Saturation is expressed in percents, from 0 to 100
	dst.s = INT(s * 100)
	'' Lightness is expressed in percents, from 0 to 100
	dst.l = INT(l * 100)
END SUB

''
'' Convert normalized RGB (Red, Green, Blue) to HSV (Hue, Saturation, Value.)
''
SUB cRGB2HSV (src AS cRGB, dst AS cHSV)
	DIM min AS SINGLE, max AS SINGLE, chroma AS SINGLE
	DIM r AS SINGLE, g AS SINGLE, b AS SINGLE
	DIM h AS SINGLE, s AS SINGLE, v AS SINGLE

	'' Cap RGB values between 0 and 1 included
	r = utilCapSng!(src.r, 0, 1)
	g = utilCapSng!(src.g, 0, 1)
	b = utilCapSng!(src.b, 0, 1)

	'' Find highest value
	max = r
	IF (g > max) THEN max = g
	IF (b > max) THEN max = b

	'' Find lowest value
	min = r
	IF (g < min) THEN min = g
	IF (b < min) THEN min = b

	'' Compute chroma
	chroma = max - min

	'' Hue
	SELECT CASE max
	CASE min
		h = 0
	CASE r
		h = ((g - b) / chroma)
	CASE g
		h = ((b - r) / chroma) + 2
	CASE ELSE
		h = ((r - g) / chroma) + 4
	END SELECT

	'' Value
	v = max

	'' Saturation
	IF (max = 0) THEN
		s = 0
	ELSE
		s = (chroma / max)
	END IF

	'' Hue is expressed in degrees, from 0 to 359
	dst.h = INT(utilModulo!(h, 6) * 60)
	IF (dst.h < 0) THEN dst.h = dst.h + 360
	'' Saturation is expressed in percents, from 0 to 100
	dst.s = INT(s * 100)
	'' Value is expressed in percents, from 0 to 100
	dst.v = INT(v * 100)
END SUB

''
'' Print HSL (Hue, Saturation, Lightness)
''
SUB printCMYK (cmyk AS cCMYK)
	PRINT "CMYK: Cyn:"; cmyk.c; "%"
	PRINT "      Mag:"; cmyk.m; "%"
	PRINT "      Ylw:"; cmyk.y; "%"
	PRINT "      Blk:"; cmyk.k; "%"
END SUB

''
'' Print HSL (Hue, Saturation, Lightness)
''
SUB printHSL (hsl AS cHSL)
	PRINT " HSL: Hue:"; hsl.h; "degrees"
	PRINT "      Sat:"; hsl.s; "%"
	PRINT "      Lit:"; hsl.l; "%"
END SUB

''
'' Print HSV (Hue, Saturation, Value)
''
SUB printHSV (hsv AS cHSV)
	PRINT " HSV: Hue:"; hsv.h; "degrees"
	PRINT "      Sat:"; hsv.s; "%"
	PRINT "      Val:"; hsv.v; "%"
END SUB

''
'' Print RGB value
''
SUB printRGB (rgb AS cRGB, bits AS INTEGER)
	DIM r AS INTEGER, g AS INTEGER, b AS INTEGER

	utilScaleRGB rgb, r, g, b, bits

	PRINT " RGB: Red:"; r
	PRINT "      Grn:"; g
	PRINT "      Blu:"; b
END SUB

''
'' Utility function: cap integer values.
''
FUNCTION utilCapInt% (i AS INTEGER, min AS INTEGER, max AS INTEGER)
	SELECT CASE i
	CASE IS < min
		utilCapInt% = min
	CASE IS > max
		utilCapInt% = max
	CASE ELSE
		utilCapInt% = i
	END SELECT
END FUNCTION

''
'' Utility function: cap floating-point values.
''
FUNCTION utilCapSng! (f AS SINGLE, min AS SINGLE, max AS SINGLE)
	SELECT CASE f
	CASE IS < min
		utilCapSng! = min
	CASE IS > max
		utilCapSng! = max
	CASE ELSE
		utilCapSng! = f
	END SELECT
END FUNCTION

''
'' Utility function: modulo for floating-point values (QuickBASIC's
'' MOD operator only returns integer values, but we desperately need
'' the decimals!)
''
FUNCTION utilModulo! (f AS SINGLE, o AS INTEGER)
	DIM c AS SINGLE

	'' Copy value
	c = f

	'' Value is below zero
	IF (c < 0) THEN
		WHILE (c <= -o)
			c = c + o
		WEND
	ELSE
		WHILE (c >= o)
			c = c - o
		WEND
	END IF

	'' Return value
	utilModulo! = c
END FUNCTION

''
'' Utility function: this function takes integers, the number of bits per
'' channel (6 for VGA, 8 for modern display,) and returns a normalized RGB
'' triplet. By default the VGA card only uses 6 bits per channel, but nowadays
'' we more often use 8 bits per channel. If we don't explicitely state the
'' number of bits per channel, things can get pretty confusing. To overcome
'' the issue, we're going to convert integers to normalized floating-point
'' values between 0 and 1. It should make rest of the code easy to port to
'' other displays.
''
SUB utilNormalizeRGB (r AS INTEGER, g AS INTEGER, b AS INTEGER, bits AS INTEGER, dst AS cRGB)
	DIM max AS INTEGER

	'' Highest possible value
	max = 2 ^ bits - 1

	'' Cap and normalize integer RGB values
	dst.r = utilCapInt%(r, 0, max) / max
	dst.g = utilCapInt%(g, 0, max) / max
	dst.b = utilCapInt%(b, 0, max) / max
END SUB

''
'' Utility function: convert normalized RGB values back to integers.
''
SUB utilScaleRGB (src AS cRGB, r AS INTEGER, g AS INTEGER, b AS INTEGER, bits AS INTEGER)
	DIM max AS INTEGER

	'' Highest possible value
	max = 2 ^ bits - 1

	'' Scale floating-point value and cap
	r = utilCapInt%(INT(src.r * max), 0, max)
	g = utilCapInt%(INT(src.g * max), 0, max)
	b = utilCapInt%(INT(src.b * max), 0, max)
END SUB