CtMapImpl.mesa
Copyright Ó 1985, 1992 by Xerox Corporation. All rights reserved.
Bloomenthal, August 23, 1992 3:52 pm PDT
Heckbert, June 13, 1988 7:23:29 pm PDT
Glassner, November 8, 1990 3:36 pm PST
DIRECTORY Basics, CtMap, Convert, FileNames, FS, Imager, ImagerColor, ImagerFont, IO, Random, RawViewers, Real, RealFns, Rope;
CtMapImpl: CEDAR MONITOR
IMPORTS Basics, Convert, FileNames, FS, Imager, ImagerFont, IO, Random, RawViewers, Real, RealFns
EXPORTS CtMap
~ BEGIN
Types
ROPE:   TYPE ~ Rope.ROPE;
Gun:   TYPE ~ CtMap.Gun;
Comp:   TYPE ~ CtMap.Comp;
CompRep:  TYPE ~ CtMap.CompRep;
Cmap:   TYPE ~ CtMap.Cmap;
CmapRep:  TYPE ~ CtMap.CmapRep;
RGB:   TYPE ~ CtMap.RGB;
Table:   TYPE ~ CtMap.Table;
TableRep:  TYPE ~ CtMap.TableRep;
ColorValue: TYPE ~ BYTE;
Basics for Reading/Writing
Read: PUBLIC PROC [out: Cmap ¬ NIL] RETURNS [Cmap] ~ {
red, grn, blu: PACKED ARRAY BYTE OF BYTE;
[red, grn, blu] ¬ RawViewers.ReadColorMap[];
IF out = NIL THEN out ¬ NewCmap[];
FOR i: NAT IN [0..256) DO
out[0][i] ¬ red[i];
out[1][i] ¬ grn[i]; 
out[2][i] ¬ blu[i];
ENDLOOP;
RETURN[out];
};
Write: PUBLIC PROC [map: Cmap] ~ {
IF map # NIL THEN {
red, grn, blu: PACKED ARRAY BYTE OF BYTE;
FOR i: NAT IN [0..256) DO
red[i] ¬ map[0][i];
grn[i] ¬ map[1][i]; 
blu[i] ¬ map[2][i];
ENDLOOP;
RawViewers.WriteColorMap[red, grn, blu];
};
};
Storage/Retrieval/Allocation Operations
justWritten: CONDITION;
NewCmap: PUBLIC PROC RETURNS [Cmap] ~ {
RETURN[NEW[CmapRep ¬ [NEW[CompRep], NEW[CompRep], NEW[CompRep]]]];
};
Write: PUBLIC PROC [map: Cmap] ~ {
IF map = NIL THEN RETURN;
FOR i: INT IN [0..256) DO
RawViewers.SetColormapEntry[i, map[0][i], map[1][i], map[2][i]];
ENDLOOP;
JustWritten[];
};
WriteEntry: PUBLIC PROC [i: NAT, rgb: RGB, cmap: Cmap ¬ NIL] ~ {
RawViewers.SetColormapEntry[i, rgb.r, rgb.g, rgb.b];
IF cmap # NIL THEN SetEntry[cmap, i, rgb];
};
WriteEntry24: PUBLIC PROC [ir, ig, ib: NAT, rgb: RGB, cmap: Cmap ¬ NIL] ~ {
RawViewers.SetColormapEntry[i, rgb.r, rgb.g, rgb.b];
IF cmap # NIL THEN SetEntry24[cmap, ir, ig, ib, rgb];
};
JustWritten: PUBLIC ENTRY PROC ~ {ENABLE UNWIND => NULL; BROADCAST justWritten};
WaitTilNew: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => NULL;
bool: BOOL ¬ FALSE;
UNTIL bool DO
WAIT justWritten;
bool ¬ TRUE;
ENDLOOP;
};
Read: PUBLIC PROC [out: Cmap ← NIL] RETURNS [Cmap] ~ {
IF out = NIL THEN out ← NewCmap[];
FOR i: NAT IN [0..256) DO
[out[0][i], out[1][i], out[2][i]] ← RawViewers.GetColormapEntry[i];
ENDLOOP;
RETURN[out];
};
ReadEntry: PUBLIC PROC [i: NAT] RETURNS [rgb: RGB] ~ {
[rgb.r, rgb.g, rgb.b] ¬ RawViewers.GetColormapEntry[i];
};
ReadEntry24: PUBLIC PROC [ir, ig, ib: NAT] RETURNS [rgb: RGB] ~ {
vt: Terminal.Virtual ← InterminalBackdoor.terminal;
IF Terminal.GetColorMode[vt].full THEN rgb ← [
Terminal.GetRedMap[vt, ir],
Terminal.GetGreenMap[vt, ib],
Terminal.GetBlueMap[vt, ib]];
};
Save: PUBLIC PROC [in: Cmap, name: ROPE] ~ {
s: IO.STREAM ¬ FS.StreamOpen[name, $create];
FOR i: INT IN [0..255] DO
IO.PutFL[s, "%3g\t%3g\t%3g\t%3g\n",
LIST[IO.int[i], IO.int[in[0][i]], IO.int[in[1][i]], IO.int[in[2][i]]]];
ENDLOOP;
IO.Close[s];
};
Load: PUBLIC PROC [name: ROPE, out: Cmap ¬ NIL] RETURNS [ok: BOOL ¬ TRUE] ~ {
s: IO.STREAM;
s ¬ FS.StreamOpen[FileNames.ResolveRelativePath[name] ! FS.Error => GOTO Bad];
IF NOT ok THEN RETURN;
ok ¬ StreamLoad[s, out];
IO.Close[s];
EXITS Bad => RETURN[FALSE];
};
StreamLoad: PUBLIC PROC [s: IO.STREAM, out: Cmap ¬ NIL] RETURNS [BOOL] ~ {
n: NAT;
bad, eos: BOOL ¬ FALSE;
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
GetVal: PROC RETURNS [NAT] ~ {
i: INTEGER;
i ¬ IO.GetInt[s ! IO.Error, IO.EndOfStream => {bad ¬ TRUE; CONTINUE}];
IF NOT bad THEN bad ¬ i < 0 OR i > 256;
RETURN[MIN[255, MAX[0, i]]];
};
GetInt: PROC RETURNS [i: INT] ~ {
i ¬ IO.GetInt[s ! IO.Error, IO.EndOfStream => {bad ¬ TRUE; CONTINUE}];
};
DO               -- skip any text before color map data
line: ROPE;
index: INT ¬ IO.GetIndex[s];
bad ¬ FALSE;
line ¬ IO.GetLineRope[s ! IO.EndOfStream, IO.Error => {bad ¬ TRUE; CONTINUE}];
IF bad THEN RETURN[FALSE];
[] ¬ Convert.IntFromRope[line ! Convert.Error => {bad ¬ TRUE; CONTINUE}];
IF NOT bad THEN {IO.SetIndex[s, index]; EXIT};
ENDLOOP;
DO               -- read arbitrary number of entries
n ¬ ABS[IO.GetInt[s !
IO.EndOfStream => {eos ¬ TRUE; CONTINUE};
IO.Error   => {bad ¬ TRUE; CONTINUE};
]];
IF eos OR bad THEN EXIT;
IF n > 255 THEN RETURN[FALSE];
FOR i: NAT IN[0..2] DO
cm[i][n] ¬ GetVal[];
IF bad THEN EXIT;
ENDLOOP;
ENDLOOP;
IF out = NIL AND NOT bad THEN WriteAndRelease[cm];
RETURN[NOT bad];
};
Copy: PUBLIC PROC [in: Cmap, out: Cmap ¬ NIL] RETURNS [Cmap] ~ {
IF in = NIL THEN RETURN[out];
IF out = NIL THEN out ¬ NewCmap[];
FOR i: NAT IN [0..2] DO FOR ii: NAT IN [0..255] DO out[i][ii] ¬ in[i][ii]; ENDLOOP; ENDLOOP;
RETURN[out];
};
CopyEntry: PUBLIC PROC [src: Cmap, isrc: NAT, dst: Cmap, idst: NAT] ~ {
dst[0][idst] ¬ src[0][isrc]; dst[1][idst] ¬ src[1][isrc]; dst[2][idst] ¬ src[2][isrc];
};
SetEntry: PUBLIC PROC [in: Cmap, i: NAT, rgb: RGB] ~ {
IF i IN [0..255] THEN {in[0][i] ¬ rgb.r; in[1][i] ¬ rgb.g; in[2][i] ¬ rgb.b};
};
SetEntry24: PUBLIC PROC [in: Cmap, ir, ig, ib: NAT, rgb: RGB] ~ {
IF ir NOT IN [0..256] OR ig NOT IN [0..256] OR ib NOT IN [0..256] THEN RETURN;
in[0][ir] ¬ rgb.r;
in[1][ig] ¬ rgb.g;
in[2][ib] ¬ rgb.b;
};
GetEntry: PUBLIC PROC [in: Cmap, i: NAT] RETURNS [rgb: RGB] ~ {
IF i IN [0..256] THEN RETURN[[in[0][i], in[1][i], in[2][i]]];
};
GetEntry24: PUBLIC PROC [in: Cmap, ir, ig, ib: NAT] RETURNS [rgb: RGB] ~ {
IF ir IN [0..256] AND ig IN [0..256] AND ib IN [0..256] THEN rgb ¬ [in[0][ir], in[1][ig], in[2][ib]];
};
Table Operations
GetTable: PUBLIC PROC [cmap: Cmap ¬ NIL, index: NAT, out: Table ¬ NIL] RETURNS [Table] ~ {
IF cmap = NIL THEN cmap ¬ Read[];
IF out = NIL THEN out ¬ NEW[TableRep];
FOR n: NAT IN [0..256) DO out[n] ¬ cmap[index][n]; ENDLOOP;
RETURN[out];
};
GetLuminanceTable: PUBLIC PROC [cmap: Cmap ¬ NIL, out: Table ¬ NIL]
RETURNS [Table]
~ {
IF out = NIL THEN out ¬ NEW[TableRep];
IF cmap = NIL THEN cmap ¬ Read[];
FOR i: INT IN [0..256) DO
out[i] ¬ MIN[255, MAX[0, Real.Round[0.30*cmap[0][i]+0.59*cmap[1][i]+0.11*cmap[2][i]]]];
ENDLOOP;
RETURN[out];
};
GetGammaTable: PUBLIC PROC [gamma: REAL, out: Table ¬ NIL] RETURNS [Table] ~ {
IF out = NIL THEN out ¬ NEW[TableRep];
FOR i: INT IN [0..256) DO
out[i] ¬ ApplyGamma[i*(1.0/255.0), gamma];
ENDLOOP;
RETURN[out];
};
Utility
ApplyGamma: PUBLIC PROC [v: REAL, gamma: REAL] RETURNS [ColorValue] ~ {
-- From ImagerColorMap.ApplyGamma[]
g: REAL ~ MIN[MAX[gamma, 0.01], 100.0];
uncorrected: REAL ~ MIN[MAX[v, 0.0], 1.0];
corrected: REAL ~ RealFns.Power[uncorrected, 1.0/g];
RETURN[Real.Round[MIN[MAX[corrected, 0.0], 1.0]*ColorValue.LAST]];
};
ApplyGammaInverse: PUBLIC PROC [colorValue: ColorValue, gamma: REAL]
RETURNS [REAL]
~ {
g: REAL ~ MIN[MAX[gamma, 0.01], 100.0];
corrected: REAL ~ REAL[colorValue]/REAL[ColorValue.LAST];
uncorrected: REAL ~ RealFns.Power[corrected, g];
RETURN[uncorrected];
};
Creation Operations
Function: PUBLIC PROC [
rFunc, gFunc, bFunc: PROC [i: NAT] RETURNS [NAT],
out: Cmap ¬ NIL]
~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..256) DO
cm[0][i] ¬ rFunc[i];
cm[1][i] ¬ gFunc[i];
cm[2][i] ¬ bFunc[i];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Mono: PUBLIC PROC [out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..256) DO cm[0][i] ¬ cm[1][i] ¬ cm[2][i] ¬ i; ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Gamma: PUBLIC PROC [gamma: REAL ¬ 2.2, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: INTEGER IN [0..256) DO
cm[0][i] ¬ cm[1][i] ¬ cm[2][i] ¬ ApplyGamma[i*(1.0/255.0), gamma];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
DeGamma: PUBLIC PROC [gamma: REAL ¬ 2.2, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: INTEGER IN [0..256) DO
cm[0][i] ¬ Real.Round[255.*ApplyGammaInverse[cm[0][i], gamma]];
cm[1][i] ¬ Real.Round[255.*ApplyGammaInverse[cm[1][i], gamma]];
cm[2][i] ¬ Real.Round[255.*ApplyGammaInverse[cm[2][i], gamma]];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Dither: PUBLIC PROC [out: Cmap ¬ NIL] ~ {
From ImagerCG6ContextImpl:
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
GC: PROC [v: REAL] RETURNS [i: NAT] ~ { -- gamma correction
i ¬ MIN[255, MAX[0, Real.Round[RealFns.Power[v/255.0, 1.0/2.2]*255.0]]];
};
FOR i: NAT IN [0..252) DO
SetEntry[cm, i+2, [GC[((i/42) MOD 6)*51.0], GC[42.5*((i/6) MOD 7)], GC[51.0*(i MOD 6)]]];
ENDLOOP;
SetEntry[cm, 0, [0, 0, 0]];
SetEntry[cm, 1, [85, 85, 85]];
SetEntry[cm, 254, [170, 170, 170]];
SetEntry[cm, 255, [255, 255, 255]];
IF out = NIL THEN WriteAndRelease[cm];
};
Ramp: PUBLIC PROC [i0, i1: NAT, rgb0, rgb1: RGB, out: Cmap ¬ NIL] ~ {
cm: Cmap;
di: REAL ¬ i1-i0;
IF di = 0.0 THEN RETURN;
cm ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: INTEGER IN [i0..i1] WHILE i >= 0 AND i <= 255 DO
s: REAL ¬ (i-i0)/di;
t: REAL ¬ 1.0-s;
cm[0][i] ¬ Real.Round[s*rgb1.r+t*rgb0.r];
cm[1][i] ¬ Real.Round[s*rgb1.g+t*rgb0.g];
cm[2][i] ¬ Real.Round[s*rgb1.b+t*rgb0.b];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
ClearColorMap: PUBLIC PROC [out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..256) DO cm[0][i] ¬ cm[1][i] ¬ cm[2][i] ¬ 0; ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
FloodPrimary: PUBLIC PROC [gun: Gun, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
SELECT gun FROM
r => FOR i: NAT IN [0..256) DO cm[0][i] ¬ 255; ENDLOOP;
g => FOR i: NAT IN [0..256) DO cm[1][i] ¬ 255; ENDLOOP;
b => FOR i: NAT IN [0..256) DO cm[2][i] ¬ 255; ENDLOOP;
ENDCASE;
IF out = NIL THEN WriteAndRelease[cm];
};
PrimaryOnly: PUBLIC PROC [gun: Gun, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE Read[];
SELECT gun FROM
r => FOR i: NAT IN [0..256) DO cm[1][i] ¬ cm[2][i] ¬ 0; ENDLOOP;
g => FOR i: NAT IN [0..256) DO cm[0][i] ¬ cm[2][i] ¬ 0; ENDLOOP;
b => FOR i: NAT IN [0..256) DO cm[0][i] ¬ cm[1][i] ¬ 0; ENDLOOP;
ENDCASE;
IF out = NIL THEN WriteAndRelease[cm];
};
Tents: PUBLIC PROC [nTents: REAL, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..256) DO
gray: INT16 ¬ Real.Fix[RealMod[2.*i*nTents, 512.]];
IF gray >= 256 THEN gray ¬ 511-gray;
cm[0][i] ¬ gray;
cm[1][i] ¬ gray;
cm[2][i] ¬ gray;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
RealMod: PROC [a, b: REAL] RETURNS [REAL] ~  -- returns (a mod b), for a and b real
{RETURN[a-Real.Floor[a/b]*b];};
Square: PUBLIC PROC [nCycles: REAL, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..256) DO
gray: INT16 ¬ IF RealMod[i*nCycles, 256.] < 128. THEN 0 ELSE 255;
cm[0][i] ¬ gray;
cm[1][i] ¬ gray;
cm[2][i] ¬ gray;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Sin: PUBLIC PROC [nRCycles, nGCycles, nBCycles: REAL ¬ 1.0, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
IF nRCycles = nGCycles AND nRCycles = nBCycles
THEN FOR i: NAT IN [1..254] DO
cm[0][i] ¬ cm[1][i] ¬ cm[2][i] ¬
Real.Round[127+127*RealFns.Sin[nRCycles*(6.28318/255.0)*(i+192)]];
ENDLOOP
ELSE FOR i: NAT IN [1..254] DO
f: REAL ¬ (6.28318/255.0)*(i+192);
cm[0][i] ¬ Real.Round[127+127*RealFns.Sin[nRCycles*f]];
cm[1][i] ¬ Real.Round[127+127*RealFns.Sin[nGCycles*f]];
cm[2][i] ¬ Real.Round[127+127*RealFns.Sin[nBCycles*f]];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Gauss: PUBLIC PROC [out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
x: REAL ¬ REAL[i]*(1.75/255.0);
cm[0][i] ¬ cm[1][i] ¬ cm[2][i] ¬ Real.Round[255.0* RealFns.Exp[-x*x]];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Scramble: PUBLIC PROC [in: Cmap, out: Cmap ¬ NIL] ~ {
r, temp: NAT;
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [1..255] DO
r ¬ Random.ChooseInt[min: 1, max: 255];
FOR ii: NAT IN [0..2] DO temp ¬ in[ii][i]; cm[ii][i] ¬ in[ii][r]; cm[ii][r] ¬ temp; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Rand: PUBLIC PROC [out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
FOR j: NAT IN[0..2] DO cm[j][i] ¬ Random.ChooseInt[max: 255]; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Arithmetic Operations
Scale: PUBLIC PROC [in: Cmap, s: REAL, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
FOR j: NAT IN[0..2] DO
cm[j][i] ¬ MAX[0, MIN[255, Real.Round[s*in[j][i]]]];
ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
TriScale: PUBLIC PROC [in: Cmap, r, g, b: REAL, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR j: NAT IN[0..2] DO
v: REAL;
SELECT j FROM
0 => v¬r;
1 => v¬g;
2 => v¬b;
ENDCASE;
FOR i: NAT IN [0..255] DO
cm[j][i] ¬ MAX[0, MIN[255, Real.Round[v*in[j][i]]]];
ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Add: PUBLIC PROC [in: Cmap, a: INTEGER, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
FOR j: NAT IN[0..2] DO cm[j][i] ¬ MAX[0, MIN[255, a+in[j][i]]]; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
CmScale: PUBLIC PROC [in1, in2: Cmap, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
FOR j: NAT IN [0..2] DO cm[j][i] ¬ in1[j][i]*in2[j][i]/255; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
CmAdd: PUBLIC PROC [in1, in2: Cmap, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
FOR j: NAT IN [0..2] DO cm[j][i] ¬ MIN[0, MAX[255, in1[j][i]+in2[j][i]]]; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Compose: PUBLIC PROC [in1, in2: Cmap, out: Cmap ¬ NIL] ~ {
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
FOR j: NAT IN [0..2] DO cm[j][i] ¬ in2[j][in1[j][i]]; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Interp: PUBLIC PROC [t: REAL, in1, in2: Cmap, out: Cmap ¬ NIL] ~ {
tt: REAL ¬ 1.0 - t;
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..255] DO
FOR j: NAT IN [0..2] DO cm[j][i] ¬ Real.Round[tt*in1[j][i]+t*in2[j][i]]; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
TriColors: PUBLIC PROC [
foreGrnd1, foreGrnd2, backgrnd: ImagerColor.RGB, gamma: REAL ¬ 2.2, out: Cmap ¬ NIL]
~ {
RealRGB: TYPE ~ ImagerColor.RGB;
Scale: PROC [v: RealRGB, s: REAL] RETURNS [r: RealRGB] ~ {r ¬ [s*v.R, s*v.G, s*v.G]};
Interp: PROC [v1, v2: RealRGB, a: REAL] RETURNS [v: RealRGB]~ {--a=1=>v2
v ¬ [v1.R+a*(v2.R-v1.R), v1.G+a*(v2.G-v1.G), v1.B+a*(v2.B-v1.B)]};
G: PROC [a: REAL] RETURNS [r: REAL] ~ {r ¬ ApplyGamma[a, gamma]};
Gam: PROC [v: RealRGB] RETURNS [r: RealRGB] ~ {r ¬ [G[v.R], G[v.G], G[v.B]]};
rgb1: RealRGB ¬ foreGrnd1;
rgb2: RealRGB ¬ backgrnd;
rgb3: RealRGB ¬ foreGrnd2;
cm: Cmap ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: INTEGER IN [0..255] DO
a: REAL ¬ REAL[IF i < 128 THEN i ELSE i-128]/127.0;
v: RealRGB ¬ IF i < 128
THEN Gam[Interp[rgb1, rgb2, a]]
ELSE Gam[Interp[rgb2, rgb3, a]];
SetEntry[cm, i, [Real.Round[v.R], Real.Round[v.G], Real.Round[v.B]]];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Modification Operations
NBits: PUBLIC PROC [in: Cmap, nBits: NAT, out: Cmap ¬ NIL] ~ {
mask: CARDINAL ¬ 0;
cm: Cmap;
IF nBits < 0 OR nBits > 7 THEN RETURN;
cm ¬ IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..nBits) DO
mask ¬ Basics.BITOR[mask, Basics.BITSHIFT[1, 7-i]];
ENDLOOP;
FOR i: NAT IN [0..255] DO
ii: CARDINAL ¬ Basics.BITAND[i, mask];
FOR j: NAT IN [0..2] DO cm[j][i] ¬ in[j][ii]; ENDLOOP;
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Cycle: PUBLIC PROC [map: Cmap, nCycle: INTEGER, red, grn, blu: BOOL ¬ TRUE]
RETURNS [Cmap] ~ {
ii: INTEGER;
modulo: NAT ~ 254;
scratch: Cmap;
IF nCycle = 0 THEN RETURN[map];
[] ¬ Copy[map, scratch ¬ ObtainCmap[]];
nCycle ¬ ((nCycle-1) MOD (modulo-1));
nCycle ¬ nCycle+(IF nCycle < 0 THEN -1 ELSE 1);
FOR i: NAT IN [1..modulo] DO
ii ¬ ((i-1)+nCycle) MOD modulo;
IF ii < 0 THEN ii ¬ modulo+ii;
ii ¬ ii+1;
IF red THEN map[0][ii] ¬ scratch[0][i];
IF grn THEN map[1][ii] ¬ scratch[1][i];
IF blu THEN map[2][ii] ¬ scratch[2][i];
ENDLOOP;
ReleaseCmap[scratch];
RETURN[map];
};
Miscellaneous Operations
nScratchCmaps: NAT ~ 6;
scratchCmaps: ARRAY [0..nScratchCmaps) OF Cmap ¬ ALL[NIL];
WriteAndRelease: PUBLIC PROC [cm: Cmap] ~ {
Write[cm];
ReleaseCmap[cm];
};
ObtainCmap: PUBLIC ENTRY PROC RETURNS [Cmap] ~ {
FOR i: NAT IN [0..nScratchCmaps) DO
cmap: Cmap ~ scratchCmaps[i];
IF cmap # NIL THEN {
scratchCmaps[i] ¬ NIL;
RETURN [cmap];
};
ENDLOOP;
RETURN [NewCmap[]];
};
ReleaseCmap: PUBLIC ENTRY PROC [cmap: Cmap] ~ {
FOR i: NAT IN [0..nScratchCmaps) DO
IF scratchCmaps[i] = NIL THEN {
scratchCmaps[i] ¬ cmap;
RETURN;
};
ENDLOOP;
};
Display Operations
font: ImagerFont.Font ¬ InitFont[];
InitFont: PROC RETURNS [font: ImagerFont.Font] ~ {
font ¬ ImagerFont.Scale[ImagerFont.Find["xerox/pressfonts/helvetica-mrr"
! Imager.Error, Imager.Warning => CONTINUE], 12.0];
};
Show: PUBLIC PROC [
context: Imager.Context, cm: Cmap, x, y: INT ¬ 0, w, h: INT, label, border: BOOL ¬ TRUE]
~ {
yMul: REAL ¬ h/(3.0*255.0);
xInc: REAL ¬ w/255.0;
wd: NAT ¬ Real.Round[xInc];
Imager.SetFont[context, font];
FOR n: NAT IN[0..2] DO
xx: REAL ¬ x;
b: NAT ¬ y+(2-n)*h/3;
IF label THEN {
Imager.SetXYI[context, w-50, 10+b];
Imager.ShowRope[context, SELECT n FROM 0 => "red", 1 => "green", ENDCASE => "blue"];
};
IF border THEN Imager.MaskRectangleI[context, 0, b, w, 1];
FOR i: NAT IN[0..255] DO
Imager.MaskRectangleI[
context, Real.Round[xx], Real.Round[b+yMul*cm[n][i]], wd, 1];
xx ¬ xx+xInc;
ENDLOOP;
ENDLOOP;
};
ShowComp: PUBLIC PROC [
context: Imager.Context, c: Comp, x, y, w, h: INT, border: BOOL ¬ TRUE, label: ROPE ¬ NIL]
~ {
yMul: REAL ¬ h/(3.0*255.0);
xInc: REAL ¬ w/255.0;
wd: NAT ¬ Real.Round[xInc];
xx: REAL ¬ x;
IF label # NIL THEN {
Imager.SetFont[context, font];
Imager.SetXYI[context, w-50, 10+y];
Imager.ShowRope[context, label];
};
IF border THEN Imager.MaskRectangleI[context, 0, y, w, 1];
FOR i: NAT IN[0..255] DO
Imager.MaskRectangleI[
context, Real.Round[xx], Real.Round[y+yMul*c[i]], wd, 1];
xx ¬ xx+xInc;
ENDLOOP;
};
END.