
    <<TRCDataImpl.mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Maureen Stone, July 18, 1989 6:40:38 pm PDT>>
        <<Tow, August 9, 1989 11:18:32 am PDT>>
    <<>>
    <<Procedures for generating, plotting and analyzing tone reproduction curves (TRC)>>
    <<>>
    DIRECTORY
        TRCData,
        Rope USING [ROPE],
        Imager,
        ImagerPath,
        ImagerInterpress,
        ImagerColor,
        CalibratedColorFns,
        Real,
        RealFns,
        PrintColorTransformations USING [TRCTable, TRCTableRec];

    TRCDataImpl: CEDAR PROGRAM
    IMPORTS Imager, ImagerInterpress, Real, ImagerPath, ImagerColor, RealFns, CalibratedColorFns
    EXPORTS TRCData
    ~ BEGIN OPEN TRCData;

        ROPE: TYPE ~ Rope.ROPE;
        TRCTable: TYPE ~ PrintColorTransformations.TRCTable;
        TRCTableRec: TYPE ~ PrintColorTransformations.TRCTableRec;
    <<TRCTable: TYPE = REF TRCTableRec;>>
    <<TRCTableRec: TYPE = ARRAY[0..LAST[BYTE]] OF NAT;>>
<<TRC Data>>

    PlotTRCData: PUBLIC PROC [data: LIST OF TRCDataRef, ipName: ROPE, scale: REAL _ 1, tx,ty: REAL _ 0] = {
        <<Defaulting scale and tx,ty will return a plot roughly 3 inches square, located at the origin.>>
        <<tx,ty should be in inches>>
        ip: ImagerInterpress.Ref _ ImagerInterpress.Create[ipName];
        max: REAL _ 0;
        unit: REAL _ scale*3.0*72.0;
        colors: ARRAY [0..5] OF ImagerColor.Color _ InitColors[];
        color: NAT _ 0;
        plotData: PROC[dc: Imager.Context, trc: TRCDataRef] = {
            step: REAL _ 1.0/(trc.length);
            traj: Imager.Trajectory _ ImagerPath.MoveTo[[0,trc[0]]];
            FOR i: NAT IN [1..trc.length) DO
                -- traj _ ImagerPath.LineTo[traj, [i*step, trc[i]]];
                traj _ ImagerPath.LineTo[traj, [i*step, trc[i] / max]];
                ENDLOOP;
            Imager.MaskStrokeTrajectory[dc, traj];
            };
        do: PROC [dc: Imager.Context] = {
            Imager.TranslateT[dc,[tx*72,ty*72]];
            --maximum in list will hit 3 inches
            -- Imager.Scale2T[dc,[unit, unit/max]];
            Imager.Scale2T[dc,[unit, unit]];
            Imager.SetStrokeWidth[dc, 1.5/unit];
            Imager.MaskVector[dc,[0,0],[1, 0]];
            -- Imager.MaskVector[dc,[0,0],[0,max]];
            Imager.MaskVector[dc,[0,0],[0,1]];
            Imager.SetStrokeWidth[dc, 1.5/unit];
            FOR list:  LIST OF TRCDataRef _ data, list.rest UNTIL list = NIL DO
                Imager.SetColor[dc,colors[color MOD 6]];
                plotData[dc, list.first];
                color _ color+1;
                ENDLOOP;
            };
        getMax: PROC[cm: REAL, trc: TRCDataRef] RETURNS[REAL] = {
            FOR i: NAT IN [0..trc.length) DO
            IF trc[i] > cm THEN cm _ trc[i]; 
                ENDLOOP;
            RETURN[cm];
            };
        FOR list:  LIST OF TRCDataRef _ data, list.rest UNTIL list = NIL DO
            max _ getMax[max, list.first];
            ENDLOOP;
        ImagerInterpress.DoPage[ip, do, Imager.metersPerPoint];
        ImagerInterpress.Close[ip];
        };
        <<>>
    InitColors: PROC [] RETURNS [colors: ARRAY [0..5] OF ImagerColor.Color] ~ {
        colors[0] _ ImagerColor.Find["Xerox/Research/Distinct/Black"];
        colors[1] _ ImagerColor.Find["Xerox/Research/Distinct/Red"];
        colors[2] _ ImagerColor.Find["Xerox/Research/Distinct/Green"];
        colors[3] _ ImagerColor.Find["Xerox/Research/Distinct/Blue"];
        colors[4] _ ImagerColor.Find["Xerox/Research/Distinct/Gray"];
        colors[5] _ ImagerColor.Find["Xerox/Research/Distinct/Yellow"];
        };
IdealRGBToLStar: ARRAY[0..255] OF BYTE _
<<RGB to LStar, ideal monitor calibration>>
[0, 9, 18, 26, 33, 39, 44, 48, 52, 56, 60, 63, 66, 69, 72, 74, 77, 79, 81, 84, 86, 88, 90, 92, 94, 96, 97, 99, 101, 103, 104, 106, 
107, 109, 110, 112, 113, 115, 116, 117, 119, 120, 121, 123, 124, 125, 126, 128, 129, 130, 131, 132, 133, 134, 136, 137, 138, 139, 
140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, 151, 151, 152, 153, 154, 155, 156, 157, 158, 159, 159, 160, 161, 162, 163, 
163, 164, 165, 166, 167, 167, 168, 169, 170, 171, 171, 172, 173, 174, 174, 175, 176, 176, 177, 178, 179, 179, 180, 181, 181, 182, 
183, 183, 184, 185, 185, 186, 187, 187, 188, 189, 189, 190, 191, 191, 192, 192, 193, 194, 194, 195, 196, 196, 197, 197, 198, 198, 
199, 200, 200, 201, 201, 202, 203, 203, 204, 204, 205, 205, 206, 206, 207, 208, 208, 209, 209, 210, 210, 211, 211, 212, 212, 213, 
213, 214, 215, 215, 216, 216, 217, 217, 218, 218, 219, 219, 220, 220, 221, 221, 222, 222, 223, 223, 224, 224, 225, 225, 225, 226, 
226, 227, 227, 228, 228, 229, 229, 230, 230, 231, 231, 232, 232, 232, 233, 233, 234, 234, 235, 235, 236, 236, 236, 237, 237, 238, 
238, 239, 239, 240, 240, 240, 241, 241, 242, 242, 242, 243, 243, 244, 244, 245, 245, 245, 246, 246, 247, 247, 247, 248, 248, 249, 
249, 249, 250, 250, 251, 251, 251, 252, 252, 253, 253, 253, 254, 254, 255, 255];

FranksOldConrac: ARRAY[0..255] OF BYTE _ [
0, 0, 0, 0, 0, 0, 1, 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 22, 25, 29, 33, 37, 40, 44, 47, 50, 53, 56, 59, 62, 66, 69, 72, 75, 77, 80, 
83, 85, 88, 91, 94, 97, 99, 102, 104, 107, 109, 111, 113, 116, 118, 120, 122, 124, 126, 128, 130, 132, 134, 135, 137, 139, 141, 
143, 145, 147, 148, 150, 152, 153, 155, 157, 158, 160, 161, 163, 165, 166, 168, 169, 171, 172, 173, 174, 175, 176, 177, 178, 179, 
181, 182, 183, 184, 185, 186, 186, 187, 188, 189, 190, 191, 191, 192, 193, 193, 194, 194, 195, 196, 197, 198, 199, 200, 201, 202, 
202, 203, 204, 204, 205, 205, 206, 206, 207, 207, 207, 208, 209, 209, 210, 211, 212, 213, 213, 214, 214, 215, 215, 215, 215, 216, 
216, 216, 216, 217, 217, 218, 218, 218, 219, 219, 220, 220, 221, 221, 221, 221, 222, 222, 223, 223, 224, 224, 225, 225, 226, 226, 
227, 227, 228, 228, 228, 229, 229, 229, 230, 230, 230, 231, 231, 231, 232, 232, 232, 232, 233, 233, 233, 233, 234, 234, 234, 235, 
235, 236, 236, 237, 237, 237, 238, 238, 238, 239, 239, 239, 240, 240, 240, 241, 241, 241, 242, 242, 242, 243, 243, 244, 244, 245, 
245, 245, 246, 246, 246, 247, 247, 248, 248, 248, 249, 249, 249, 249, 250, 250, 250, 251, 251, 251, 251, 251, 251, 251, 252, 252, 
252, 252, 253, 253, 253, 254, 254, 254, 254, 255, 255];

FranksConrac: ARRAY[0..255] OF BYTE _ [
0, 0, 1, 2, 2, 3, 4, 5, 7, 8, 10, 12, 14, 17, 19, 21, 24, 26, 29, 31, 34, 36, 39, 41, 44, 46, 49, 51, 53, 56, 58, 60, 62, 65, 67, 
69, 71, 73, 75, 77, 79, 81, 82, 84, 86, 88, 90, 92, 93, 95, 97, 98, 100, 102, 103, 105, 106, 108, 110, 111, 113, 114, 116, 117, 
119, 120, 121, 123, 124, 126, 127, 128, 130, 131, 132, 133, 135, 136, 137, 138, 139, 141, 142, 143, 144, 145, 146, 148, 149, 150, 
151, 152, 154, 155, 156, 157, 158, 159, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 
179, 180, 181, 181, 182, 183, 184, 185, 186, 186, 187, 188, 189, 190, 191, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 
202, 202, 203, 204, 205, 205, 206, 207, 207, 208, 208, 209, 210, 210, 211, 212, 212, 213, 213, 214, 215, 215, 216, 217, 217, 218, 
218, 219, 220, 220, 221, 221, 222, 222, 223, 223, 224, 225, 225, 226, 226, 227, 227, 228, 228, 229, 229, 230, 230, 231, 231, 231, 
232, 232, 233, 233, 234, 234, 235, 235, 236, 236, 237, 237, 238, 238, 239, 239, 239, 240, 240, 241, 241, 242, 242, 242, 243, 243, 
244, 244, 245, 245, 246, 246, 246, 247, 247, 248, 248, 248, 249, 249, 249, 250, 250, 250, 251, 251, 251, 251, 252, 252, 252, 252, 
253, 253, 253, 253, 254, 254, 254, 254, 255, 255
];


MiksConrac: ARRAY[0..255] OF BYTE _
<<RGB to LStar, measured by Mik Lamming, 1988>>
[0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 4, 5, 6, 9, 11, 14, 16, 19, 22, 25, 29, 32, 35, 37, 39, 42, 44, 46, 48, 51, 53, 56, 58, 60, 
62, 64, 66, 68, 70, 72, 74, 76, 78, 80, 82, 83, 85, 87, 88, 90, 91, 93, 94, 95, 97, 98, 100, 101, 103, 104, 106, 107, 109, 110, 
112, 113, 114, 116, 117, 118, 119, 121, 122, 123, 125, 126, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 
143, 144, 145, 146, 147, 149, 150, 151, 152, 153, 153, 154, 155, 156, 157, 159, 160, 161, 162, 163, 164, 165, 166, 167, 168, 168, 
169, 170, 171, 172, 172, 173, 174, 175, 176, 177, 178, 179, 180, 181, 181, 182, 183, 184, 185, 185, 186, 187, 188, 189, 189, 190, 
191, 192, 193, 193, 194, 195, 196, 197, 197, 198, 199, 200, 201, 201, 202, 203, 204, 205, 205, 206, 207, 208, 208, 209, 209, 210, 
211, 212, 212, 213, 214, 215, 216, 216, 217, 218, 218, 219, 219, 220, 220, 221, 221, 222, 222, 223, 224, 224, 225, 225, 226, 227, 
227, 228, 228, 229, 230, 230, 231, 231, 232, 232, 233, 233, 234, 234, 235, 235, 236, 236, 237, 238, 238, 239, 239, 240, 241, 241, 
242, 242, 243, 243, 244, 244, 245, 245, 245, 246, 246, 247, 247, 247, 248, 248, 249, 249, 249, 250, 250, 251, 251, 251, 252, 252, 
253, 253, 253, 254, 254, 255, 255];
    <<>>
    RGBToLStar: PUBLIC PROC[type: ATOM] RETURNS [TRCDataRef] = {
        <<For the monitor TRCs.  $Ideal, $MiksConrac, $FranksConrac ...>>
        table: TRCTable;
        SELECT type FROM
            $Ideal => table _ NEW[TRCTableRec _ IdealRGBToLStar];
            $MiksConrac => table _ NEW[TRCTableRec _ MiksConrac];
            $FranksOldConrac => table _ NEW[TRCTableRec _ FranksOldConrac];
            $FranksConrac => table _ NEW[TRCTableRec _ FranksConrac];
            $Linear => {
                table _ NEW[TRCTableRec];
                FOR i: NAT IN [0..255] DO table[i] _ i; ENDLOOP;
                };
            ENDCASE => ERROR;
        RETURN[FromTRCTable[table]];
        };


        RGBToLStarTRCTable:PUBLIC PROC[type: ATOM] RETURNS [TRCTable] = {
        table: TRCTable;
        SELECT type FROM
            $Ideal => table _ NEW[TRCTableRec _ IdealRGBToLStar];
            $MiksConrac => table _ NEW[TRCTableRec _ MiksConrac];
            $FranksOldConrac => table _ NEW[TRCTableRec _ FranksOldConrac];
            $FranksConrac => table _ NEW[TRCTableRec _ FranksConrac];
            $Linear => {
                table _ NEW[TRCTableRec];
                FOR i: NAT IN [0..255] DO table[i] _ i; ENDLOOP;
                };
            ENDCASE => ERROR;
        RETURN[table];
        };

<<Data Manipulators>>

    NewDataRef: PROC [length: NAT] RETURNS [TRCDataRef] ~ {
        ref: TRCDataRef _ NEW[TRCDataRec[length]];
        ref.length _ length;
        RETURN[ref] 
        };
    IntensityToDensity: PUBLIC PROC[maxSampleOut, maxSampleIn: NAT _ 255, maxD: REAL _ 2.0] RETURNS[rgbToDensity, densityToRGB: 
    TRCDataRef] = {
        <<Treats incoming pixels as linear intensity, outputs RGB in linear density for optronics transparencies.>>
        density: PROC [pixel: NAT] RETURNS[REAL] = {
            RETURN[RealFns.Log[base: 10, arg: REAL[maxSampleIn]/pixel]];
            };
        reflectance: PROC [pixel: NAT] RETURNS[REAL] = {
            RETURN[1.0/RealFns.Power[base: 10, exponent: pixel/scale]];
            };
        scale: REAL _ maxSampleOut/maxD;
    rgbToDensity _ NewDataRef[maxSampleIn];
    densityToRGB _ NewDataRef[maxSampleOut];
        rgbToDensity[0] _ maxSampleOut;
        densityToRGB[0] _ maxSampleIn;
        FOR i: NAT IN [1..maxSampleIn] DO
            rgbToDensity[i] _ MIN[255, REAL[Real.Round[scale*density[i]]]];
            densityToRGB[i] _ MIN[255, REAL[Real.Round[reflectance[i]*maxSampleIn]]];
            ENDLOOP;
        };
    LuminaceToLStar: PUBLIC PROC [data: TRCDataRef] RETURNS [TRCDataRef] = {
        newData: TRCDataRef _ NewDataRef[data.length];
        white: REAL _ data[data.length-1];
    FOR i: NAT IN [0..data.length) DO
    newData[i] _ CalibratedColorFns.LStarFromLuminance[Y: data[i], whiteY: white];
    ENDLOOP;
    RETURN[newData];
    };
    ApplyGamma: PUBLIC PROC [data: TRCDataRef, gamma: REAL] RETURNS [TRCDataRef] ~ {
        max: REAL _ data[data.length-1];
        new: TRCDataRef _ NewDataRef[data.length];
        FOR i: NAT IN [0..data.length) DO
            new[i] _ max*RealFns.Power[data[i]/max, 1.0/gamma];
            ENDLOOP;
        RETURN[new];
        };
    MakeTRC: PUBLIC PROC [data: TRCDataRef, smoothCount: NAT] RETURNS [TRCDataRef] ~ {
        <<Scale to fit 0..255>>
        step: NAT _ 255/(data.length-1);    -- better be an even multiple for now
        min: REAL _ LAST[Sample];
        max: REAL _ 0;
        scale, offset: REAL;
    trc: TRCDataRef _ NewDataRef[256];
    interp: PROC[index: NAT]  RETURNS [val: REAL]= {
    start: NAT _ index / step;
    end: NAT _ 1 + index/step;
    difference, distance: REAL;

    distance _ index - (start * step);
    distance _ distance / step;
    difference _ data[end] - data[start];
    val _ data[start] + distance * (data[end] - data[start]);
    };

    smooth: PROC = {
        old, current: REAL _ 0;
    old _ trc[0];
    FOR i: NAT IN [1..254] DO
        current _ trc[i];
    trc[i] _ (old+current+trc[i+1])/3;
    old _ current;
        ENDLOOP;
    };
    <<interpolate first>>
    trc[0] _ data[0];
    trc[255] _ data[data.length-1];
    FOR i: NAT IN [1..254] DO
    trc[i] _ interp[i];
    ENDLOOP;

    <<Smooth the data>>
    FOR i: NAT IN [0..smoothCount) DO smooth[]; ENDLOOP;
    <<scale trc to 0..255>>
    FOR i: NAT IN [0..255] DO
        IF trc[i] < min THEN min _ trc[i];
        IF trc[i] > max THEN max _ trc[i];
        ENDLOOP;

        scale _ 255.0/(max-min);
        offset _ -min;
    FOR i: NAT IN [0..255] DO
    trc[i] _ (trc[i]+offset)*scale;
        ENDLOOP;
        RETURN[trc];
        };

<<Converters>>
    ToTRCTable: PUBLIC PROC [data: TRCDataRef, smoothCount: NAT] RETURNS [TRCTable] = {
        <<For compatibilty with PrintColorTransformations.   TRCTable is an array of 8 bit values.>>
        table: TRCTable _ NEW[TRCTableRec];
    trc:  TRCDataRef _ MakeTRC[data, smoothCount];
        FOR i: NAT IN [0..256) DO
            table[i] _ Real.Round[MIN[255, MAX[0, data[i]]]];
            ENDLOOP;
        RETURN[table];
        };
        <<>>
        FromTRCTable: PUBLIC PROC [table: TRCTable] RETURNS [TRCDataRef] = {
            <<And the inverse>>
            data: TRCDataRef _ NewDataRef[256];
            FOR i: NAT IN [0..256) DO
                data[i] _ table[i];
                ENDLOOP;
            RETURN[data];
            };
<<Raw Data>>
    <<--Measurements of Frank Crow's color monitor.
    --R=G=B from 0 through 255 in steps of 5.
    --All values are in foot lamberts.>>
    <<-- Minolta values:>>
    Minolta: ARRAY [0..51] OF REAL _ [
         0.2,  0.2,  0.3,  0.4,  0.7,  1.0,  1.4,  1.8,  2.3,  2.8,
         3.3,  3.8,  4.3,  4.9,  5.4,  6.0,  6.5,  6.9,  7.4,  7.7,
         8.1,  8.3,  8.8,  9.2,  9.4,  9.6, 10.1, 10.3, 10.4, 10.6,
        10.9, 11.0, 11.3, 11.6, 11.8, 12.0, 12.2, 12.3, 12.5, 12.8,
        13.0, 13.2, 13.4, 13.7, 13.9, 14.2, 14.3, 14.6, 14.6, 14.8,
        15.0, 15.1];
    <<--Photo Research values>>
    PhotoResearch: ARRAY [0..51] OF REAL _ [
        2.151,  2.060,  2.089,  2.154,  2.409,  2.675,  3.018,  3.416,  3.768,  4.203,
        4.479,  4.829,  5.190,  5.530,  5.948,  6.282,  6.695,  7.026,  7.255,  7.462,
        7.863,  8.079,  8.342,  8.640,  8.816,  9.013,  9.239,  9.422,  9.574,  9.690,
        9.840,  9.997, 10.21,  10.31,  10.58,  10.70,  10.87,  10.88,  11.13,  11.35,
        11.42,  11.68,  11.82,  11.99,  12.11,  12.28,  12.38,  12.57,  12.60,  12.79,
        12.95,  13.01];
    <<--Frank's new monitor, Minolta values>>
    FranksMonitorData: ARRAY [0..51] OF REAL _ [
  1.0,  1.0,  1.3,  2.0,  2.9,  3.9,  5.1,  6.4,  7.7,  9.1,
 10.7, 12.1, 13.7, 15.3, 17.1, 18.6, 20.2, 21.8, 23.6, 25.5,
 27.4, 29.3, 30.8, 32.9, 34.5, 36.0, 37.6, 39.6, 42.1, 43.9,
 45.0, 46.7, 48.0, 49.7, 51.5, 52.3, 54.2, 55.6, 56.6, 58.0,
 59.5, 60.9, 62.0, 63.0, 64.8, 66.0, 67.0, 68.5, 69.1, 69.9,
 70.4, 71.5];

    <<>>
    MakeTRCData: PROC [data: ATOM] RETURNS [TRCDataRef] = {
        ref: TRCDataRef _ NewDataRef[52];
        SELECT data FROM
            $FranksMonitorData => FOR i: NAT IN [0..51] DO
                ref[i] _ FranksMonitorData[i];
                ENDLOOP;
            $Minolta => FOR i: NAT IN [0..51] DO
                ref[i] _ Minolta[i];
                ENDLOOP;
            $PhotoResearch => FOR i: NAT IN [0..51] DO
                ref[i] _ PhotoResearch[i];
                ENDLOOP;
            ENDCASE => ERROR;
        RETURN[ref];
        };

    END.