
<<ColorTrixMapImpl.mesa>>
<<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<Bloomenthal, September 3, 1986 3:54:17 pm PDT>>

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] ~ {
vt: Terminal.Virtual _ InterminalBackdoor.terminal;
IF Terminal.GetColorMode[vt].full
THEN { 
    Terminal.SetRedMap[vt, i, r];
    Terminal.SetGreenMap[vt, i, g];
    Terminal.SetBlueMap[vt, i, b];
}
ELSE 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 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, 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: INTEGER;
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;
};

}.