ColorTrixMapImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Bloomenthal, January 18, 1986 1:03:49 am PST
DIRECTORY Basics, ColorTrixMap, Convert, FS, Imager, ImagerColorMap, ImagerFont, ImagerTransformation, InterminalBackdoor, IO, Real, RealFns, Random, Rope, Terminal;
ColorTrixMapImpl: CEDAR MONITOR
IMPORTS Basics, Convert, FS, Imager, ImagerColorMap, ImagerFont, InterminalBackdoor, IO, Random, Real, RealFns, Terminal
EXPORTS ColorTrixMap
~ {
Gun: TYPE ~ ImagerColorMap.Gun;
Comp: TYPE ~ ColorTrixMap.Comp;
CompRep: TYPE ~ ColorTrixMap.CompRep;
Cmap: TYPE ~ ColorTrixMap.Cmap;
CmapRep: TYPE ~ ColorTrixMap.CmapRep;
Storage/Retrieval/Allocation Operations
NewCmap: PUBLIC PROC RETURNS [Cmap] ~ {
RETURN[NEW[CmapRep ← [NEW[CompRep], NEW[CompRep], NEW[CompRep]]]];
};
justWritten: CONDITION;
JustWritten: PUBLIC ENTRY PROC ~ {ENABLE UNWIND => NULL; BROADCAST justWritten};
Write: PUBLIC PROC [map: Cmap] ~ {
vt: Terminal.Virtual ← InterminalBackdoor.terminal;
IF map = NIL THEN RETURN;
IF Terminal.GetColorMode[vt].full
THEN FOR i: NAT IN [0..256) DO
Terminal.SetRedMap[vt, i, map[0][i]];
Terminal.SetGreenMap[vt, i, map[1][i]];
Terminal.SetBlueMap[vt, i, map[2][i]];
ENDLOOP
ELSE FOR i: NAT IN [0..256) DO
Terminal.SetColor[vt, i, , map[0][i], map[1][i], map[2][i]];
ENDLOOP;
JustWritten[];
};
WriteEntry: PUBLIC PROC [i, r, g, b: NAT] ~ {
Terminal.SetColor[InterminalBackdoor.terminal, i, , r, g, b];
};
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] ~ {
vt: Terminal.Virtual ← InterminalBackdoor.terminal;
IF out = NIL THEN out ← NewCmap[];
IF Terminal.GetColorMode[vt].full
THEN FOR i: NAT IN [0..256) DO
out[0][i] ← Terminal.GetRedMap[vt, i];
out[1][i] ← Terminal.GetGreenMap[vt, i];
out[2][i] ← Terminal.GetBlueMap[vt, i];
ENDLOOP
ELSE FOR i: INTEGER IN [0..256) DO
[out[0][i], out[1][i], out[2][i]] ← Terminal.GetColor[vt: vt, aChannelValue: i];
ENDLOOP;
RETURN[out];
};
ReadEntry: PUBLIC PROC [map: Cmap, i: NAT] RETURNS [r, g, b: NAT] ~ {
RETURN[map[0][i], map[1][i], map[2][i]];
};
Save: PUBLIC PROC [in: Cmap, name: Rope.ROPE] ~ {
s: IO.STREAM ← FS.StreamOpen[name, $create];
FOR i: INT IN [0..255] DO
IO.PutF[s, "%3g\t%3g\t%3g\t%3g\n", 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.ROPE, out: Cmap ← NIL] RETURNS [BOOL] ~ {
s: IO.STREAM;
ok: BOOL ← TRUE;
s ← FS.StreamOpen[name ! FS.Error => {ok ← FALSE; CONTINUE}];
IF NOT ok THEN RETURN[ok];
ok ← StreamLoad[s, out];
IO.Close[s];
RETURN[ok];
};
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 [Terminal.ChannelValue] ~ {
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.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 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, r, g, b: NAT] ~ {
in[0][i] ← r; in[1][i] ← g; in[2][i] ← b;
};
GetEntry: PUBLIC PROC [in: Cmap, i: NAT] RETURNS [r, g, b: NAT] ~ {
RETURN[in[0][i], in[1][i], in[2][i]];
};
Creation Operations
Function: PUBLIC PROC [rFunc, gFunc, bFunc: ColorTrixMap.FuncProc, 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] ← ImagerColorMap.ApplyGamma[i*(1.0/256.0), gamma];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
Ramp: PUBLIC PROC [i0, r0, g0, b0, i1, r1, g1, b1: NAT, 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*r1+t*r0];
cm[1][i] ← Real.Round[s*g1+t*g0];
cm[2][i] ← Real.Round[s*b1+t*b0];
ENDLOOP;
IF out = NIL THEN WriteAndRelease[cm];
};
ClearColorTrixMap: 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
red =>  FOR i: NAT IN [0..256) DO cm[0][i] ← 255; ENDLOOP;
green => FOR i: NAT IN [0..256) DO cm[1][i] ← 255; ENDLOOP;
blue => 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 ObtainCmap[];
SELECT gun FROM
red => FOR i: NAT IN [0..256) DO cm[1][i] ← cm[2][i] ← 0; ENDLOOP;
green => FOR i: NAT IN [0..256) DO cm[0][i] ← cm[2][i] ← 0; ENDLOOP;
blue => 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: NAT, out: Cmap ← NIL] ~ {
tentWidth: NAT ← 256/nTents;
cm: Cmap ← IF out # NIL THEN out ELSE ObtainCmap[];
FOR i: NAT IN [0..nTents] DO
[] ← Ramp[i*tentWidth, 0, 0, 0, i*tentWidth+tentWidth/2, 255, 255, 255, cm];
[] ← Ramp[i*tentWidth+tentWidth/2, 255, 255, 255, (i+1)*tentWidth, 0, 0, 0, cm];
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..255] DO
cm[0][i] ← cm[1][i] ← cm[2][i] ← Real.Round[127.5+127.5*RealFns.Sin[nRCycles*(6.28318/255.0)*(i+192)]];
ENDLOOP
ELSE FOR i: NAT IN [1..255] DO
cm[0][i] ← Real.Round[127.5+127.5*RealFns.Sin[nRCycles*(6.28318/255.0)*(i+192)]];
cm[1][i] ← Real.Round[127.5+127.5*RealFns.Sin[nGCycles*(6.28318/255.0)*(i+192)]];
cm[2][i] ← Real.Round[127.5+127.5*RealFns.Sin[nBCycles*(6.28318/255.0)*(i+192)]];
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];
};
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: NAT;
modulo: NAT ~ 255;
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];
};
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.RoundI[s*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]/4095; 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];
};
Random Creation Operations
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];
};
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 ← ImagerFont.Scale[ImagerFont.Find["xerox/pressfonts/helvetica-mrr"], 12.0];
Show: PUBLIC PROC [context: Imager.Context, cm: Cmap, x, y: INTEGER ← 0, w, h: INTEGER, 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.RoundI[xx], Real.RoundI[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.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.RoundI[xx], Real.RoundI[y+yMul*c[i]], wd, 1];
xx ← xx+xInc;
ENDLOOP;
};
}.