DIRECTORY ColorMap, ColorMapImpl, ColorPackagePrivate, ConvertUnsafe, Graphics, GraphicsOps, JaMFnsDefs, Map, Real, Rope, TJaMGraphics; Color8Impl: CEDAR PROGRAM IMPORTS ColorMap, ColorMapImpl, ColorPackagePrivate, ConvertUnsafe, Graphics, GraphicsOps, JaMFnsDefs, Map, Real, TJaMGraphics SHARES ColorMapImpl = BEGIN table: Map.ColorTable; palette: Map.PalTable; Init: PROCEDURE [] = TRUSTED { JaMFnsDefs.Register["LoadMap"L, JLoadMap]; JaMFnsDefs.Register["ShowRawImage"L, JShowRawImage]; JaMFnsDefs.Register["RestoreMap"L, JRestoreMap]; JaMFnsDefs.Register["RotateMap"L, JRotateMap]; }; JLoadMap: PROCEDURE [] = TRUSTED { s:LONG STRING _ [50]; JaMFnsDefs.PopString[s]; LoadMap[ConvertUnsafe.ToRope[s]]; }; LoadMap: PROCEDURE [file:Rope.ROPE] = TRUSTED { [table, palette] _ Map.Restore[file]; ColorPackagePrivate.SetNewColorMapProc[PalMapper]; SetUpMap[palette]; }; RestoreMap: PROCEDURE [] = TRUSTED { ColorPackagePrivate.SetNewColorMapProc[ColorMapImpl.MyGetIndex]; ColorMap.StandardMap[]; }; JRestoreMap: PROCEDURE [] = TRUSTED { RestoreMap[]; }; JShowRawImage: PROCEDURE [] = TRUSTED { s:LONG STRING _ [50]; paint: PROC [dc: Graphics.Context] = TRUSTED { Graphics.DrawImage[self:dc, image:GraphicsOps.NewAisImage[ConvertUnsafe.ToRope[s]], raw:TRUE]; }; JaMFnsDefs.PopString[s]; TJaMGraphics.Painter[paint]; }; PalMapper: ColorPackagePrivate.ColorMapProc = TRUSTED { RETURN [Map.GetIndex[r,g,b, table]]; }; SetUpMap: PROCEDURE [p:Map.PalTable] = TRUSTED { FOR palix:CARDINAL IN [0..p.size) DO ColorMap.SetRGBColor[palix, p[palix].r, p[palix].g, p[palix].b]; ENDLOOP; }; ToRange: PROC[v: REAL] RETURNS[REAL] = INLINE { IF v IN[0..1] THEN RETURN[v] ELSE ERROR }; -- ensures that v is in [0..1]; raises BoundsFault if not HSVToRGB: 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: 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; }; RotateMap: PROCEDURE [n:INTEGER] = TRUSTED { lr,lg,lb,h,s,v:REAL; WHILE n>0 DO FOR i:CARDINAL IN [0..20] DO -- maximise saturations FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; s _ MIN[s + i / 20.0, 1.0] ; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; FOR i:CARDINAL DECREASING IN [0..20] DO -- reduce the saturations to 0 FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; s _ i/20.0 ; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; FOR i:CARDINAL IN [0..10] DO -- threshold values around 0.5 FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; v _ IF v>0.5 THEN MIN[v+i*0.05, 1.0] ELSE MAX[v-i*0.05, 0.0] ; s _ 0; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; FOR i:CARDINAL DECREASING IN [0..10] DO -- restore values FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; v _ IF v>0.5 THEN MIN[v+i*0.05, 1.0] ELSE MAX[v-i*0.05, 0.0] ; s _ 0; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; FOR pix:CARDINAL IN [0..palette.size) DO -- go red OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; h _ 1.0 ; s _ 0.0; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; FOR i:CARDINAL IN [0..20] DO -- maximise saturations FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; s _ i / 20.0 ; h _ 1.0; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; FOR i:CARDINAL DECREASING IN [0..40] DO -- rotate colors FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; h _ i / 40.0 ; s _ 1.0; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; -- NB hue is now 0 FOR i:CARDINAL DECREASING IN [0..20] DO -- reduce the value to 0 FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; h _ 0.0; v _ v * i/20.0; s _ 1.0 ; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; FOR pix:CARDINAL IN [0..palette.size) DO -- restore the colors OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; s _ 1.0; v _ 0.0; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; FOR i:CARDINAL IN [0..20] DO -- restore values FOR pix:CARDINAL IN [0..palette.size) DO OPEN palette[pix]; [h,s,v] _ RGBToHSV[r,g,b]; v _ v * i/20.0; [lr,lg,lb] _ HSVToRGB[h,s,v]; ColorMap.SetRGBColor[pix, lr,lg,lb]; ENDLOOP; ENDLOOP; n _ n - 1; ENDLOOP; }; JRotateMap: PROCEDURE [] = TRUSTED { RotateMap[1]; }; Init[]; END. <Color8Impl.mesa Mik Lamming - July 15, 1983 4:35 pm Κ—˜J™J™#J™˜ Jšœ ˜ Jšœ ˜ Jšœ˜Jšœ˜Jšœ ˜ Jšœ ˜ Jšœ ˜ Jšœ˜J˜Jšœ˜Jšœ ˜ —J˜šΟn œΟk œ˜Jšžœw˜~Jšžœž˜Jšœ˜Jšœ˜J˜šœž œžœ˜Jšœ*˜*Jšœ4˜4Jšœ0˜0Jšœ.˜.J˜J˜—šœž œžœ˜"Jšœžœžœ˜Jšœ˜Jšœ!˜!J˜J˜—šœž œ žœžœ˜/Jšœ%˜%Jšœ2˜2Jšœ˜J˜J˜—š œž œžœ˜$Jšœ@˜@Jšœ˜J˜J˜—š œž œžœ˜%J˜ J˜J˜—š œž œžœ˜'Jšœžœžœ˜Jšœžœžœ[žœ˜Jšœ˜Jšœ˜J˜J˜—š œ%žœ˜7Jšžœ˜$Jšœ˜J˜—procšœž œžœ˜0šžœžœžœ ž˜$Jšœ@˜@Jšžœ˜—Jšœ˜J˜—JšœžœžœžœžœžœžœžœžœžœžœžœΟc'œ Ÿ˜–J˜Jš0œžœžœžœžœžœžœžœžœžœ(ŸœŸœžœžœožœžœžœžœžœžœžœžœžœžœ˜ΩJš;œœžœžœžœžœžœ>žœžœ Ÿœ žœžœ ŸœžœžœžœŸœžœžœΠbkœ Ÿœ\žœžœ žœžœžœ žœžœžœžœ˜—š œž œžœžœ˜,Kšœžœ˜šžœž˜ šžœž œ žœŸ˜4šžœžœžœž˜(Jšžœ˜Jšœ˜Jšœžœ˜Jšœ˜Jšœ$˜$Jšžœ˜—Jšž˜—š žœžœž œ žœŸ˜Fšžœžœžœž˜(Jšžœ˜Jšœ˜Jšœ ˜ Jšœ˜Jšœ$˜$Jšžœ˜—Jšž˜—š žœžœžœ žœŸ˜;šžœžœžœž˜(Jšžœ˜Jšœ˜Jš œžœžœžœžœžœ˜>J˜Jšœ˜Jšœ$˜$Jšžœ˜—Jšž˜—š žœžœž œ žœŸ˜9šžœžœžœž˜(Jšžœ˜Jšœ˜Jš œžœžœžœžœžœ˜>J˜Jšœ˜Jšœ$˜$Jšžœ˜—Jšž˜—š žœžœžœžœŸ ˜2Jšžœ˜Jšœ˜Jšœ ˜ J˜Jšœ˜Jšœ$˜$Jšžœ˜—šžœž œ žœŸ˜4šžœžœžœž˜(Jšžœ˜Jšœ˜Jšœ˜J˜Jšœ˜Jšœ$˜$Jšžœ˜—Jšž˜—š žœžœž œ žœŸ˜8šžœžœžœž˜(Jšžœ˜Jšœ˜Jšœ˜J˜Jšœ˜Jšœ$˜$Jšžœ˜—JšžœŸ˜—š žœžœž œ žœŸ˜@šžœžœžœž˜(Jšžœ˜Jšœ˜J˜J˜Jšœ ˜ Jšœ˜Jšœ$˜$Jšžœ˜—Jšž˜—š žœžœžœžœŸ˜>Jšžœ˜Jšœ˜J˜Jšœ˜Jšœ$˜$Jšžœ˜—š žœžœžœ žœŸ˜.šžœžœžœž˜(Jšžœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ$˜$Jšžœ˜—Jšž˜—J˜ Jšžœ˜—Jšœ˜J˜—š œž œžœ˜$Kšœ ˜ Jšœ˜J˜—J˜J˜Jšžœ˜——…—Π£