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

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

CGColorImpl: CEDAR PROGRAM 
IMPORTS CGColor, Inline, Real, Runtime
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 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 _ CGColor.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
 
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_bc-gc
     ELSE IF g=max THEN h_2+rc-bc
     ELSE IF b=max THEN h_4+gc-rc;
     h _ h / 6.0;
     IF h<0 THEN h_h+1;
     RETURN[h, s, v];
   };

}.