-- CGColorImpl.mesa
-- Last edited by Maureen Stone, September 18, 1982 2:07 pm
-- Last edited by Doug Wyatt, November 12, 1982 1:30 pm
-- Last edited by Paul Rovner, June 8, 1983 11:08 pm
-- Color definitions and colormap routines

DIRECTORY
CGColor USING [Color, GetStipple],
GraphicsColor USING [],
PrincOpsUtils USING[BITSHIFT, BITAND],
Real USING [FixI, RoundC],
RuntimeError USING [BoundsFault];

CGColorImpl: CEDAR PROGRAM
IMPORTS CGColor, PrincOpsUtils, Real, RuntimeError
EXPORTS CGColor, GraphicsColor = {

Color: TYPE = CGColor.Color;
Byte: TYPE = [0..256);

ToRange: PROC[v: REAL] RETURNS[REAL] = INLINE { IF v IN[0..1] THEN RETURN[v]
ELSE ERROR RuntimeError.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 ← CGColor.GetStipple[color];
count: NAT ← 0;
FOR i: CARDINAL IN[0..16) DO TRUSTED {
IF PrincOpsUtils.BITAND[bits,1]=0 THEN count ← count+1; -- count "white" bits
bits ← PrincOpsUtils.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

HSVToRGB: PUBLIC PROC[h,s,v: REAL] RETURNS[r,g,b: REAL] = {
hue: REAL ← ToRange[h];
saturation: REAL ← ToRange[s];
value: REAL ← ToRange[v];
 ihue: INTEGER;
 fhue,m,n,k: REAL;
 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[0,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];
};

}.