--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; }; 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_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]; }; 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; }; }. &--NewCGColorImpl.mesa --Last edited by Maureen Stone, July 8, 1983 11:19 am --Last edited by Doug Wyatt, November 12, 1982 1:30 pm 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 ΚΠ– "cedar" style˜Iprocšœ™Kšœ5™5Kšœ6™6KšΟc*˜*šΟk ˜ Kšœ žœ ˜0Kšœžœ˜Kšœžœžœžœ˜Kšœžœ˜Kšœžœ˜—Kšœžœžœ˜Kšžœ"˜)Kšžœ˜&Kšœžœ˜Kšœžœ ˜Kšœ žœ˜&Kšœžœžœžœ˜!K˜KšΟnœžœžœžœžœžœžœžœžœžœ˜LKšœžœžœ˜$Kš'Οi ˜:Kš Ÿœžœžœžœ žœžœ ˜UKš˜Kš Ÿœžœžœ žœžœ"˜_š Ÿœžœžœ žœžœ ˜AKšœ%˜%Kšžœ˜—š Ÿ œžœžœžœžœ ˜7Kšœ˜Kšœ˜Kšœ˜Kšžœ˜!—š œŸ œžœžœžœžœ ˜8Kšœžœ˜)Kšžœ+˜1—š œŸœžœžœžœ žœ˜Išžœ ž˜šœ žœ˜Kšžœžœžœ ˜7Kšžœ,˜0Kšœ˜—Kšœ1˜1Kšžœ˜—Kšžœ ˜Kšœ˜—Kšœ˜š Ÿ œžœžœžœ žœ˜@šžœ ž˜KšœG˜GKšœ8˜8Kšžœ˜—Kšžœ˜Kšœ˜—š œŸ œžœžœžœ žœ˜Ašžœ ž˜Kšœžœ7˜DKšœžœžœ ˜DKšžœžœ ˜—Kšœ˜—š œŸœžœžœ žœ˜cKšœžœ ˜.Kšœžœ˜š žœžœžœžœžœ˜&Kšžœžœ žœ˜FKšœžœ ˜"Kšžœ˜—Kšœ˜Kšœ˜—Kšœ4™4Kšœ/™/Kšœ™Kšœ!™!Kšœ˜š Ÿœžœžœžœžœžœ˜;Kšœžœ˜ Kšœ žœ˜Kšœžœ˜Kšœžœ˜Kšœ žœ˜šžœ žœ˜Kšžœžœžœ˜0Kšžœžœ ˜—Kšžœ˜Kšœ ˜ Kšœ ˜$Kšœ˜!Kšžœžœ ˜Kšœ˜Kšœ ˜ Kšœ$˜$šžœž˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšžœžœ˜—Kšœ˜—š œŸœžœžœžœžœžœ˜Kšžœžœ žœ ˜>Kšžœžœ˜K˜ Kšžœžœ ˜K˜—K˜Kšœ˜K˜—…—ός