--NewCGColorImpl.mesa
--Last edited by Maureen Stone, July 8, 1983 11:19 am
--Last edited by Doug Wyatt, November 12, 1982 1:30 pm
--Color definitions and colormap routines
DIRECTORY
NewCGColor USING [Color, GetStipple, undefined],
GraphicsColor USING [],
Inline USING[BITSHIFT, BITAND],
Real USING [FixI, RoundC],
Runtime USING [BoundsFault];
NewCGColorImpl: CEDAR PROGRAM
IMPORTS NewCGColor, Inline, Real, Runtime
EXPORTS NewCGColor, GraphicsColor = {
Color: TYPE = NewCGColor.Color;
Byte: TYPE = [0..256);
undefined: REAL= NewCGColor.undefined;
InvalidColor: PUBLIC SIGNAL=CODE;
ToRange: PROC[v: REAL] RETURNS[REAL] = INLINE { IF v IN[0..1] THEN RETURN[v]
ELSE ERROR Runtime.BoundsFault };
-- ensures that v is in [0..1]; raises BoundsFault if not
ToByte: PROC[v: REAL] RETURNS[Byte] = INLINE { RETURN[Real.RoundC[ToRange[v]*255]] };
-- assumes v IN[0..1]
MakeRGB: PROC[r, g, b: Byte] RETURNS[Color] = INLINE { RETURN[[tag: rgb, r: r, g: g, b: b]] };
IntensityToColor: PUBLIC PROC[intensity: REAL] RETURNS[Color] = {
i: Byte ← ToByte[ToRange[intensity]];
RETURN[MakeRGB[i, i, i]] };
RGBToColor: PUBLIC PROC[r,g,b: REAL] RETURNS[Color] = {
red: Byte ← ToByte[ToRange[r]];
grn: Byte ← ToByte[ToRange[g]];
blu: Byte ← ToByte[ToRange[b]];
RETURN[MakeRGB[red, grn, blu]] };

HSVToColor: PUBLIC PROC[h,s,v: REAL] RETURNS[Color] = {
r,g,b: REAL; [r,g,b] ← HSVToRGB[h, s, v];
RETURN[MakeRGB[ToByte[r],ToByte[g],ToByte[b]]] };

ColorToIntensity: PUBLIC PROC[color: Color] RETURNS[intensity: REAL] = {
SELECT color.tag FROM
rgb => { i: REAL;
IF color.b=color.r AND color.g=color.r THEN i ← color.r
ELSE i ← 0.30*color.r+0.11*color.b+0.59*color.g;
intensity ← i/255.0 };
stipple => intensity ← StippleToIntensity[color];
ENDCASE => intensity ← 0;
RETURN[intensity];
};
ColorToHSV: PUBLIC PROC[color: Color] RETURNS[h, s, v: REAL] = {
SELECT color.tag FROM
rgb => [h,s,v] ← RGBToHSV[color.r/255.0, color.g/255.0, color.b/255.0];
stipple => { h ← s ← 0; v ← StippleToIntensity[color] };
ENDCASE => h ← s ← v ← 0;
RETURN[h,s,v];
};

ColorToRGB: PUBLIC PROC[color: Color] RETURNS[r, g, b: REAL] = {
SELECT color.tag FROM
rgb => RETURN[r: color.r/255.0, g: color.g/255.0, b: color.b/255.0];
stipple => { i: REAL ← StippleToIntensity[color]; RETURN[i, i, i] };
ENDCASE => RETURN[0, 0, 0];
};

StippleToIntensity: PROC[color: Color] RETURNS[intensity: REAL] = { -- assumes color.tag = stipple
bits: CARDINAL ← NewCGColor.GetStipple[color];
count: NAT ← 0;
FOR i: CARDINAL IN[0..16) DO TRUSTED {
IF Inline.BITAND[bits,1]=0 THEN count ← count+1; -- count "white" bits
bits ← Inline.BITSHIFT[bits,-1] };
ENDLOOP;
intensity ← count/16.0;
};
These algorithms use the hexacone model described in
"Color Gamut Transform Pairs" by Alvy Ray Smith
Siggraph 1978, p. 12.
Algorithms from Foley and van Dam
HSVToRGB: PUBLIC PROC[h,s,v: REAL] RETURNS[r,g,b: REAL] = {
hue: REAL;
saturation: REAL ← ToRange[s];
value: REAL ← ToRange[v];
ihue: INTEGER;
fhue,m,n,k: REAL;
IF h=undefined THEN
IF saturation=0 THEN {r ← g ← b ← value; RETURN}
ELSE SIGNAL InvalidColor
ELSE hue ← ToRange[h];
hue ← hue*6;
ihue ← Real.FixI[hue]; --integer hue
fhue ← hue-ihue; --fractional hue
IF ihue=6 THEN ihue ← 0;
m ← value*(1-saturation);
n ← value*(1-(saturation*fhue));
k ← value*(1-(saturation*(1-fhue)));
SELECT ihue FROM
0 => RETURN[value,k,m];
1 => RETURN[n,value,m];
2 => RETURN[m,value,k];
3 => RETURN[m,n,value];
4 => RETURN[k,m,value];
5 => RETURN[value,m,n];
ENDCASE => RETURN[0,0,0];
};

RGBToHSV: PUBLIC PROC[r,g,b: REAL] RETURNS[h,s,v: REAL] = {
max,min,rc,gc,bc: REAL;
r ← ToRange[r]; g ← ToRange[g]; b ← ToRange[b];
min ← MIN[MIN[r,g],b]; --amount of white
v ← max ← MAX[MAX[r,g],b];--maximum "brightness"
IF max#0 THEN s ← (max-min)/max
ELSE s ← 0;
IF s=0 THEN RETURN[undefined,0,v]; --gray
rc ← (max - r)/(max - min);
gc ← (max - g)/(max - min);
bc ← (max - b)/(max - min);
IF r=max THEN h�-gc
ELSE IF g=max THEN h𡤂+rc-bc
ELSE IF b=max THEN h𡤄+gc-rc;
h ← h / 6.0;
IF h<0 THEN h←h+1;
RETURN[h, s, v];
};
HSLToRGB: PUBLIC PROC[h, s, l: REAL] RETURNS[r, g, b: REAL] = {
m1,m2,hue,saturation, lightness: REAL;
Value: PROC[n1,n2,h1: REAL] RETURNS[v: REAL] = {
IF h1 > 360 THEN h1 ← h1-360;
IF h1 < 0 THEN h1 ← h1+360;
v ← SELECT TRUE FROM
h1 IN [0..60) => n1+(n2-n1)*h1/60,
h1 IN [60..180) => n2,
h1 IN [180..240) => n1+(n2-n1)*(240-h1)/60,
ENDCASE => n1;
};
saturation ← ToRange[s];
lightness ← ToRange[l];
IF h=undefined THEN
IF saturation=0 THEN {r ← g ← b ← lightness}
ELSE SIGNAL InvalidColor
ELSE hue ← 360*ToRange[h];
m2 ← IF lightness <= 0.5
THEN lightness*(1+saturation)
ELSE lightness+saturation-lightness*saturation;
m1 ← 2*lightness-m2;
r ← Value[m1,m2,hue+120];
g ← Value[m1,m2,hue];
b ← Value[m1,m2,hue-120];
};
RGBToHSL: PUBLIC PROC[r, g, b: REAL] RETURNS[h, s, l: REAL] = {
max,min,rc,gc,bc,del: REAL;
red: REAL ← ToRange[r];
green: REAL ← ToRange[g];
blue: REAL ← ToRange[b];
max ← MAX[red,MAX[green,blue]];
min ← MIN[red,MIN[green,blue]];
l ← (max+min)/2;
IF max=min THEN RETURN[undefined,0,l]; --gray
del ← max-min;
s ← IF l <= 0.5 THEN del/(max+min) ELSE del/(2-max-min);
rc ← (max-red)/del;
gc ← (max-green)/del;
bc ← (max-blue)/del;
IF max = red THEN h ← bc-gc --between yellow and magenta
ELSE IF max = green THEN h ← 2+rc-bc --between cyan and yellow
ELSE IF max = blue THEN h ← 4+gc-rc --between magenta and cyan
ELSE SIGNAL InvalidColor;
h ← h/6.0;
IF h < 0 THEN h ← h+1;
};
}.