
    <<ImagerDitheredDeviceImpl.mesa>>
        <<Copyright © 1984, 1985 by Xerox Corporation.  All rights reserved.>>
        <<Michael Plass, August 1, 1985 3:32:25 pm PDT>>
        <<Doug Wyatt, May 30, 1985 11:25:23 pm PDT>>

DIRECTORY
Basics USING [BITAND, BITSHIFT, bitsPerWord, BoundsCheck, BYTE, LongDivMod, LongMult, LongNumber, RawBytes, RawWords],
FunctionCache USING [Cache, CompareProc, GlobalCache, Insert, Lookup],
II USING [ClassRep, Context],
IICache USING [GetNamedCache, Ref],
IIColor USING [RGB],
IIColorDefs USING [Color, ColorOperator, ColorRep, ConstantColor, ConstantColorClassRep, ConstantColorImplRep, SampledColor],
IIColorMap USING [MapEntry, StandardColorMapEntries],
IIColorOperator USING [GetColorOperatorClass, Mapper, MapPixels, NewMapper],
IIColorPrivate USING [ConstantColorClass, ConstantColorClassRep, ConstantColorImpl, ConstantColorImplRep],
IIDevice USING [BoxProc, Class, ClassRep, Device, DeviceBox, DeviceRep, HalftoneParameters, RunProc],
IIDither USING [CreateTable, Dither, DitherConstant, InitTable, Pack, PackedColorDesc, PackSequence, Table, WordDither, 
WordDitherConstant],
IIDitheredDevice USING [MapEntries, SpecialPixel],
IIDitheredDevicePrivate USING [Data, DataRep, SampledColorData, SampledColorDataRep, StippleArray],
IIMask USING [RunsFromBits, RunsFromBox],
IIPixelArray USING [GetPixels, MaxSampleValue],
IIPixelArrayDefs USING [PixelArray],
IIPixelMap USING [BoundedWindow, Clip, Create, DeviceRectangle, PixelMap, PixelMapRep, ShiftMap],
IIRaster USING [Create],
IISample USING [GetPointer, GetPointSamples, NewBuffer, Sample, SampleBuffer, Sampler, SamplerRep, SetSamplerIncrements, 
SetSamplerPosition, UnsafePutF, UnsafeSamples],
IITransformation USING [ApplyPreRotate, Cat, Transformation, Translate],
PrincOps USING [BBTableSpace, BitBltTable, BitBltTablePtr, DstFunc, op, zBNDCK, zINC],
PrincOpsUtils USING [AlignedBBTable, BITBLT, LongCopy],
Real USING [RoundC],
Terminal USING [FrameBuffer, GetColorFrameBufferA, GetColorFrameBufferB, ModifyColorFrame, Virtual],
Vector2 USING [VEC];

    IIDitheredDeviceImpl: CEDAR PROGRAM
    IMPORTS Basics, FunctionCache, IICache, IIColorMap, IIColorOperator, IIDither, IIMask, IIPixelArray, IIPixelMap, IIRaster, 
    IISample, IITransformation, PrincOpsUtils, Real, Terminal
    EXPORTS IIColorDefs, IIRaster, IIDitheredDevice
    ~ BEGIN OPEN IIDevice, IIDitheredDevicePrivate;

    BYTE: TYPE ~ Basics.BYTE;
    VEC: TYPE ~ Vector2.VEC;
    Transformation: TYPE ~ IITransformation.Transformation;
    Color: TYPE ~ IIColorDefs.Color;
    ConstantColor: TYPE ~ IIColorDefs.ConstantColor;
    SampledColor: TYPE ~ IIColorDefs.SampledColor;
    ColorOperator: TYPE ~ IIColorDefs.ColorOperator;
    PixelArray: TYPE ~ IIPixelArrayDefs.PixelArray;
    PixelMap: TYPE ~ IIPixelMap.PixelMap;
    Sample: TYPE ~ IISample.Sample;
    SampleBuffer: TYPE ~ IISample.SampleBuffer;
    UnsafeSamples: TYPE ~ IISample.UnsafeSamples;

    RawBytes: TYPE ~ Basics.RawBytes;
    RawWords: TYPE ~ Basics.RawWords;

    ConstantColorImpl: TYPE ~ IIColorPrivate.ConstantColorImpl;
    ConstantColorImplRep: PUBLIC TYPE ~ IIColorPrivate.ConstantColorImplRep;

    ConstantColorClass: TYPE ~ IIColorPrivate.ConstantColorClass;
    ConstantColorClassRep: PUBLIC TYPE ~ IIColorPrivate.ConstantColorClassRep;

    bitsPerWord: NAT ~ Basics.bitsPerWord;

    class: IIDevice.Class ~ NEW[IIDevice.ClassRep _ [
        type: $DitheredColorDisplay,
        SetColor: DitheredSetColor,
        SetPriority: DitheredSetPriority,
        SetHalftone: DitheredSetHalftone,
        MaskRuns: DitheredMaskRuns,
        MaskBoxes: DitheredMaskBoxes,
        MaskBits: DitheredMaskBits,
        MoveBoxes: DitheredMoveBoxes
        ]];

    Lg: PROC [n: NAT] RETURNS [NAT] ~ {
        RETURN[SELECT n FROM 1 => 0, 2 => 1, 4 => 2, 8 => 3, 16 => 4, ENDCASE => ERROR]
        };

    PixelMapFromFrameBuffer: PROC [frameBuffer: Terminal.FrameBuffer] 
    RETURNS [IIPixelMap.PixelMap] ~ {
        refRep: REF IIPixelMap.PixelMapRep ~ NEW[IIPixelMap.PixelMapRep _ [
            ref: frameBuffer,
            pointer: frameBuffer.base,
            words: INT[frameBuffer.wordsPerLine]*INT[frameBuffer.height],
            lgBitsPerPixel: Lg[frameBuffer.bitsPerPixel],
            rast: frameBuffer.wordsPerLine,
            lines: frameBuffer.height
            ]];
        frame: IIPixelMap.PixelMap ~ [
            sOrigin: 0, fOrigin: 0, sMin: 0, fMin: 0,
            sSize: frameBuffer.height, fSize: frameBuffer.width, refRep: refRep
            ];
        RETURN[frame];
        };

    fontCacheID: ATOM ~ $ColorDisplay;
    fontCacheSize: NAT _ 4000;
    fontRastWeight: REAL _ 0.0;

    ContextFromPixelMap: PUBLIC PROC [frame: IIPixelMap.PixelMap, displayHeight: NAT, pixelUnits: BOOL _ FALSE] RETURNS [II.Context] ~ {
        fontCache: IICache.Ref ~ IICache.GetNamedCache[
        atom: fontCacheID, createSize: fontCacheSize];
        RETURN [IIRaster.Create[device: DeviceFromPixelMap[frame, displayHeight], pixelUnits: pixelUnits, fontCache: fontCache, rastWeight: 
        fontRastWeight]];
        };

    ContextFromColorTerminal: PUBLIC PROC [vt: Terminal.Virtual, pixelUnits: BOOL _ FALSE] RETURNS [II.Context] ~ {
        fontCache: IICache.Ref ~ IICache.GetNamedCache[
        atom: fontCacheID, createSize: fontCacheSize];
        RETURN [IIRaster.Create[device: DeviceFromColorTerminal[vt], pixelUnits: pixelUnits, fontCache: fontCache, rastWeight: 
        fontRastWeight]];
        };

    SetMapEntries: PROC [data: Data, mapEntries: IIDitheredDevice.MapEntries] ~ {
        data.mapEntries _ mapEntries;
            <<Might want to do some pre-computation here someday.>>
        };

    DeviceFromPixelMap: PUBLIC PROC [frame: IIPixelMap.PixelMap, displayHeight: NAT, pixelsPerInch: REAL _ 72] RETURNS 
    [IIDevice.Device] ~ {
        bitsPerPixel: NAT ~ Basics.BITSHIFT[1, frame.refRep.lgBitsPerPixel];
        mapEntries: IIDitheredDevice.MapEntries ~ IIColorMap.StandardColorMapEntries[bitsPerPixel];
        w: IIPixelMap.DeviceRectangle ~ IIPixelMap.BoundedWindow[frame];
        pm: IIPixelMap.PixelMap ~ frame.Clip[w].ShiftMap[-w.sMin, -w.fMin];
        sampBuffer: SampleBuffer ~ IISample.NewBuffer[1, pm.fMin+pm.fSize];
        lineBuffer: SampleBuffer ~ IISample.NewBuffer[1, pm.fMin+pm.fSize];
        sampler: IISample.Sampler ~ NEW[IISample.SamplerRep _ []];
        data: Data ~ NEW[DataRep _ [frame: pm, sampBuffer: sampBuffer, lineBuffer: lineBuffer, sampler: sampler]];
        surfaceToDevice: Transformation ~ IITransformation.Translate[[displayHeight+w.sMin, w.fMin]];
        surfaceToDevice.ApplyPreRotate[90];
        SetMapEntries[data, mapEntries];
        RETURN[NEW[IIDevice.DeviceRep _ [class: class,
            box: [smin: data.frame.sMin, fmin: data.frame.fMin, smax: w.sSize, fmax: w.fSize],
            surfaceToDevice: surfaceToDevice,
            surfaceUnitsPerInch: [pixelsPerInch, pixelsPerInch],
            surfaceUnitsPerPixel: 1,
            data: data]]];
        };

    DeviceFromColorTerminal: PUBLIC PROC [vt: Terminal.Virtual, aChannel: BOOL _ TRUE] RETURNS [IIDevice.Device] ~ {
        frameBuffer: Terminal.FrameBuffer ~ IF aChannel THEN Terminal.GetColorFrameBufferA[vt] ELSE Terminal.GetColorFrameBufferB[vt];
        pm: PixelMap ~ PixelMapFromFrameBuffer[frameBuffer];
        device: IIDevice.Device ~ DeviceFromPixelMap[pm, frameBuffer.height, vt.colorPixelsPerInch];
        data: Data ~ NARROW[device.data];
        data.terminal _ vt;
        RETURN [device];
        };

    NewColorMapDevice: PUBLIC PROC [terminal: Terminal.Virtual, bpp: NAT _ 8] RETURNS[Device] ~ {
        RETURN [DeviceFromColorTerminal[terminal]];
        };

    nullBitBltTable: PrincOps.BitBltTable ~ [
        dst: [word: NIL, bit: 0], dstBpl: 0,
        src: [word: NIL, bit: 0], srcDesc: [srcBpl[0]],
        width: 0, height: 0, flags: []
        ];

    StippleArrayFromWord: PROC [t: WORD] RETURNS[array: StippleArray _ ALL[0]] ~ {
        bits: PACKED ARRAY [0..16) OF BOOL ~ LOOPHOLE[t];
        FOR i: [0..16) IN [0..16) DO IF bits[i] THEN array[i] _ WORD.LAST ENDLOOP;
        };

    PixelFromIntensity: PROC[i: REAL] RETURNS[BYTE] ~ {
        IF i<=0 THEN RETURN[0];
        IF i>=1 THEN RETURN[BYTE.LAST];
        RETURN[Real.RoundC[i*BYTE.LAST]];
        };

    replicator: ARRAY [0..4] OF WORD ~ [0FFFFH, 5555H, 1111H, 0101H, 1];

    ReplicatePixel: PROC [value: WORD, lgBitsPerPixel: [0..4]] RETURNS [WORD] ~ {
        max: WORD ~ Basics.BITSHIFT[1, Basics.BITSHIFT[1, lgBitsPerPixel]]-1;
        value _ Basics.BITAND[value, max];
        RETURN [value*replicator[lgBitsPerPixel]];
        };

    DitheredSetColor: PROC [device: Device, color: Color, viewToDevice: Transformation] ~ {
        data: Data ~ NARROW[device.data];
        data.case _ nil;
        data.sampledColor _ NIL;
        data.sampledColorData _ NIL;
        WITH color SELECT FROM
            color: ConstantColor => {
                impl: ConstantColorImpl ~ color.impl;
                data.flags _ [disjoint: TRUE, gray: TRUE, srcFunc: null, dstFunc: null];
                WITH color.data SELECT FROM
                    special: REF SpecialPixel => {
                        data.grayWord _ ReplicatePixel[special.value, data.frame.refRep.lgBitsPerPixel];
                        data.case _ constant;
                        data.flags.dstFunc _ special.dstFunc;
                        };
                    ENDCASE => {
                        WITH impl: impl SELECT FROM
                            stipple => {
                                word: WORD ~ impl.word;
                                SELECT impl.function FROM
                                    replace => { data.flags.srcFunc _ complement };
                                    paint => { data.flags.srcFunc _ complement; data.flags.dstFunc _ and };
                                    invert => { data.flags.dstFunc _ xor };
                                    erase => { data.flags.dstFunc _ or };
                                    ENDCASE => ERROR;
                                IF word=WORD.LAST THEN {data.grayWord _ word; data.case _ constant}
                                ELSE { data.stipple _ StippleArrayFromWord[word]; data.case _ stipple };
                                };
                            rgb => {
                                pixelR: BYTE ~ PixelFromIntensity[impl.val.R];
                                pixelG: BYTE ~ PixelFromIntensity[impl.val.G];
                                pixelB: BYTE ~ PixelFromIntensity[impl.val.B];
                                data.packedRGB _ IIDither.Pack[pixelR, pixelG, pixelB, packing];
                                data.case _ rgb;
                                };
                            ENDCASE => {
                                value: BYTE ~ PixelFromIntensity[impl.Y];
                                data.packedRGB _ IIDither.Pack[value, value, value, packing];
                                data.case _ rgb;
                                };
                        };
                };
            color: SampledColor => {
                pa: PixelArray ~ color.pa;
                um: Transformation ~ color.um;
                colorOperator: ColorOperator ~ color.colorOperator;
                data.sampledColor _ color;
                data.case _ sampled;
                data.zerosAreClear _ IIColorOperator.GetColorOperatorClass[colorOperator] = $SampledBlackClear;
                data.paToDevice _ IITransformation.Cat[pa.m, color.um, viewToDevice];
                SetUpSampledColorData[data];
                };
            ENDCASE => ERROR; -- unknown color variant
        IF data.case = rgb OR data.case = sampled THEN {
            SetUpDitherTable[data];
            };
        IF data.case # constant THEN {
            IF viewToDevice.integerTrans THEN {
                data.sTileOrg _ sTileSize-Mod[viewToDevice.tx, sTileSize];
                data.fTileOrg _ fTileSize-Mod[viewToDevice.ty, fTileSize];
                }
            ELSE {data.sTileOrg _ data.fTileOrg _ 0};
            };
        };

    Mod: PROC [n: INTEGER, d: NAT] RETURNS [NAT] ~ {
        nn: Basics.LongNumber _ [li[n]];
        IF nn.li < 0 THEN nn.highbits _ nn.highbits + d;
        RETURN [Basics.LongDivMod[nn.lc, d].remainder];
        };

    DitheredSetPriority: PROC [device: Device, priorityImportant: BOOL] ~ {
        };

    DitheredSetHalftone: PROC [device: Device, halftone: HalftoneParameters] ~ {
        data: Data ~ NARROW[device.data];
        <<data.halftone _ halftone;>>
        };

    Check: PROC[x: CARDINAL, max: NAT] RETURNS[NAT] ~
        TRUSTED MACHINE CODE { PrincOps.zINC; PrincOps.zBNDCK };
        <<IF x IN[0..max] THEN RETURN[x] ELSE ERROR RuntimeError.BoundsFault>>

    DitheredMaskRunsInternal: PROC[data: Data, bounds: DeviceBox, runs: PROC[RunProc]] ~ TRUSTED {
        frame: PixelMap ~ data.frame;
        base: LONG POINTER ~ frame.refRep.pointer;
        wordsPerLine: NAT ~ frame.refRep.rast;
        bbspace: PrincOps.BBTableSpace;
        bb: PrincOps.BitBltTablePtr ~ PrincOpsUtils.AlignedBBTable[@bbspace];
        lgBitsPerPixel: NAT ~ frame.refRep.lgBitsPerPixel;
        bitsPerPixel: NAT ~ Basics.BITSHIFT[1, lgBitsPerPixel];
        heightLimit: NAT ~ frame.sMin+frame.sSize;
        widthLimit: NAT ~ frame.fMin+frame.fSize;
        SELECT data.case FROM
            nil => ERROR; -- color not initialized
            constant => {
                ditheredConstantRun: PROC[sMin, fMin: INTEGER, fSize: NAT] ~ TRUSTED {
                    fmin: NAT ~ Check[fMin, widthLimit];
                    fmax: NAT ~ Check[fmin+fSize, widthLimit];
                    smin: NAT ~ Basics.BoundsCheck[sMin, heightLimit];
                    bit: CARDINAL ~ Basics.BITSHIFT[fmin, lgBitsPerPixel];
                    bb.dst.word _ base+Basics.LongMult[smin, wordsPerLine]+bit/bitsPerWord;
                    bb.dst.bit _ bit MOD bitsPerWord;
                    bb.width _ Basics.BITSHIFT[(fmax-fmin), lgBitsPerPixel];
                    PrincOpsUtils.BITBLT[bb];
                    };
                bb^ _ nullBitBltTable;
                bb.srcDesc.gray _ [yOffset: 0, widthMinusOne: 0, heightMinusOne: 0];
                bb.src.word _ LOOPHOLE[@data.grayWord];
                bb.dstBpl _ wordsPerLine*bitsPerWord;
                bb.height _ 1;
                bb.flags _ data.flags;
                runs[ditheredConstantRun];
                };
            stipple => {
                lineBuffer: IISample.SampleBuffer ~ data.lineBuffer;
                stippleRun: PROC[sMin, fMin: INTEGER, fSize: NAT] ~ TRUSTED {
                    fmin: NAT ~ Check[fMin, widthLimit];
                    fmax: NAT ~ Check[fmin+fSize, widthLimit];
                    smin: NAT ~ Basics.BoundsCheck[sMin, heightLimit];
                    srcLine: IISample.UnsafeSamples ~ lineBuffer.GetPointer[0, 0, fSize];
                    sBase: NAT ~ (smin MOD 4) * 4;
                    fStartMax: NAT _ MIN[fmax, fmin+4];
                    FOR f: NAT IN [fmin..fStartMax) DO
                        lineBuffer[f-fmin] _ data.stipple[sBase + f MOD 4];
                        ENDLOOP;
                    IF fmax > fStartMax THEN {
                        PrincOpsUtils.LongCopy[from: srcLine, nwords: fmax-fStartMax, to: srcLine+4];
                        };
                    IISample.UnsafePutF[samples: srcLine, count: fSize, s: smin, f: fmin, base: base, wordsPerLine: wordsPerLine, bitsPerSample: 
                    bitsPerPixel, srcFunc: data.flags.srcFunc, dstFunc: data.flags.dstFunc];
                    };
                runs[stippleRun];
                };
            rgb => {
                IF bitsPerPixel = 8 THEN {
                    rgbSampledRun8: PROC[sMin, fMin: INTEGER, fSize: NAT] ~ TRUSTED {
                        s: NAT ~ Basics.BoundsCheck[sMin, heightLimit];
                        f: NAT ~ Check[fMin, widthLimit];
                        count: NAT ~ Check[fSize, widthLimit-f];
                        IIDither.DitherConstant[destLine: base+Basics.LongMult[s, wordsPerLine], start: f, count: fSize, packed: data.packedRGB, sTile: 
                        s+data.sTileOrg, fTile: f+data.fTileOrg, table: data.table];
                        };
                    runs[rgbSampledRun8];
                    }
                ELSE {
                    lineBuf: LONG POINTER TO RawWords ~ data.lineBuffer.GetPointer[0, 0, widthLimit];
                    rgbSampledRun: PROC[sMin, fMin: INTEGER, fSize: NAT] ~ TRUSTED {
                        s: NAT ~ Basics.BoundsCheck[sMin, heightLimit];
                        f: NAT ~ Check[fMin, widthLimit];
                        count: NAT ~ Check[fSize, widthLimit-f];
                        IIDither.WordDitherConstant[destLine: lineBuf, start: 0, count: fSize, packed: data.packedRGB, sTile: s+data.sTileOrg, fTile: 
                        f+data.fTileOrg, table: data.table];
                        IISample.UnsafePutF[samples: lineBuf, count: fSize, s: s, f: f, base: base, wordsPerLine: wordsPerLine, bitsPerSample: 
                        bitsPerPixel];
                        };
                    runs[rgbSampledRun];
                    };
                };
            sampled => {
                table: IIDither.Table ~ data.table;
                scd: SampledColorData ~ data.sampledColorData;
                dstFunc: PrincOps.DstFunc ~ IF data.zerosAreClear THEN and ELSE null;
                IF data.paToDevice.form = 3 AND data.paToDevice.integerTrans AND bitsPerPixel = 8 AND dstFunc = null THEN {
                    refRep: REF IIPixelMap.PixelMapRep ~ scd.source.refRep;
                    sSizeSource: NAT ~ scd.source.sSize;
                    fSizeSource: NAT ~ scd.source.fSize;
                    ditheredSampledRunFast: PROC[sMin, fMin: INTEGER, fSize: NAT] ~ TRUSTED {
                        smin: NAT ~ Check[sMin, heightLimit];
                        fmin: NAT _ Check[fMin, widthLimit];
                        count: NAT _ Check[fSize, widthLimit-fmin];
                        sMinSource: INTEGER ~ Mod[INT[smin]-data.paToDevice.tx, sSizeSource];
                        fMinSource: INTEGER _ Mod[INT[fmin]-data.paToDevice.ty, fSizeSource];
                        dstLine: LONG POINTER ~ base+Basics.LongMult[smin, wordsPerLine];
                        srcLine: LONG POINTER ~ refRep.pointer+Basics.LongMult[NAT[sMinSource], refRep.rast];
                        UNTIL count = 0 DO
                            delta: NAT ~ MIN[count, fSizeSource-fMinSource];
                            IIDither.Dither[destLine: dstLine, start: fmin, count: delta, packed: srcLine+fMinSource, sTile: smin+data.sTileOrg, fTile: 
                            fmin+data.fTileOrg, table: data.table];
                            fMinSource _ fMinSource + delta;
                            IF fMinSource >= fSizeSource THEN fMinSource _ fMinSource-fSizeSource;
                            fmin _ fmin + delta;
                            count _ count - delta;
                            ENDLOOP;
                        };
                    runs[ditheredSampledRunFast]
                    }
                ELSE {
                    t: IIPixelMap.PixelMap ~ scd.source;
                    sampBuffer: SampleBuffer ~ data.sampBuffer;
                    sampler: IISample.Sampler ~ data.sampler;
                    sampler.base _ t.refRep.pointer;
                    sampler.wordsPerLine _ t.refRep.rast;
                    sampler.bitsPerSample _ 16;
                    sampler.sMin _ t.sMin;
                    sampler.fMin _ t.fMin;
                    sampler.sSize _ t.sSize;
                    sampler.fSize _ t.fSize;
                    IISample.SetSamplerIncrements[sampler, data.paToDevice];
                    IISample.SetSamplerPosition[sampler: sampler, m: data.paToDevice, s: bounds.smin, f: bounds.fmin];
                    IF bitsPerPixel = 8 AND dstFunc = null THEN {
                        ditheredSampledRun8: PROC[sMin, fMin: INTEGER, fSize: NAT] ~ TRUSTED {
                            s: NAT ~ Basics.BoundsCheck[sMin, heightLimit];
                            f: NAT ~ Check[fMin, widthLimit];
                            count: NAT ~ Check[fSize, widthLimit-f];
                            sampPointer: IISample.UnsafeSamples ~ sampBuffer.GetPointer[0, f, count];
                            IISample.GetPointSamples[sampler: sampler, s: s, f: f, buffer: sampBuffer, bi: 0, bj: f, count: count];
                            IIDither.Dither[destLine: base+Basics.LongMult[s, wordsPerLine], start: f, count: fSize, packed: sampPointer, sTile: 
                            s+data.sTileOrg, fTile: f+data.fTileOrg, table: data.table];
                            };
                        runs[ditheredSampledRun8]
                        }
                    ELSE {
                        lineBuf: LONG POINTER TO RawWords ~ data.lineBuffer.GetPointer[0, 0, widthLimit];
                        ditheredSampledRun: PROC[sMin, fMin: INTEGER, fSize: NAT] ~ TRUSTED {
                            s: NAT ~ Basics.BoundsCheck[sMin, heightLimit];
                            f: NAT ~ Check[fMin, widthLimit];
                            count: NAT ~ Check[fSize, widthLimit-f];
                            sampPointer: IISample.UnsafeSamples ~ sampBuffer.GetPointer[0, 0, count];
                            IISample.GetPointSamples[sampler: sampler, s: s, f: f, buffer: sampBuffer, bi: 0, bj: 0, count: count];
                            IIDither.WordDither[destLine: lineBuf, start: 0, count: fSize, packed: sampPointer, sTile: s+data.sTileOrg, fTile: f+data.fTileOrg, 
                            table: data.table];
                            IISample.UnsafePutF[samples: lineBuf, count: fSize, s: s, f: f, base: base, wordsPerLine: wordsPerLine, bitsPerSample: 
                            bitsPerPixel, dstFunc: dstFunc];
                            };
                        runs[ditheredSampledRun];
                        };
                    };
                };
            ENDCASE => ERROR; -- illegal case
        };

    me: REF TEXT ~ "Dith"; -- a globally unique REF for use as a clientID in the global cache.

    packing: IIDither.PackedColorDesc _ [4, 4, 4, 4];
    sTileSize: NAT _ 3;
    fTileSize: NAT _ 3;

    ExamineDitherTable: PROC [r, g, b: NAT, bitsPerPixel: NAT _ 8] RETURNS [a: ARRAY[0..16) OF NAT] ~ {
        <<For debugging.>>
        data: Data ~ NEW[DataRep _ [sampBuffer:NIL, lineBuffer:NIL, sampler:NIL]];
        data.mapEntries _ IIColorMap.StandardColorMapEntries[bitsPerPixel];
        SetUpDitherTable[data];
        IF data.table#NIL THEN TRUSTED {
            packed: WORD ~ IIDither.Pack[r, g, b, packing];
            array: LONG POINTER TO RawBytes ~ data.table.space.pointer;
            FOR i: NAT IN [0..16) DO
                a[i] _ array[packed+i];
                ENDLOOP;
            }
        ELSE ERROR;
        };

    specialTwoBits: BOOL _ TRUE;
        <<This causes the assumption that the two-bit-per-pixel case has the additive primaries and black; the gamut of the input gets 
        effectively chopped in half in this case, so white is obtained by dithering red, green, and blue in approximately equal 
        proportions.>>
        <<>>
    SetUpDitherTable: PROC [data: Data] ~ {
        table: IIDither.Table _ data.table;
        IF table = NIL OR table.packing # packing OR table.sTileSize # sTileSize OR table.fTileSize # fTileSize THEN {
            cache: FunctionCache.Cache _ FunctionCache.GlobalCache[];
            compare: FunctionCache.CompareProc ~ {RETURN [argument = data.mapEntries]};
            table _ NARROW[FunctionCache.Lookup[cache, compare, me].value];
            IF table = NIL OR table.packing # packing OR table.sTileSize # sTileSize OR table.fTileSize # fTileSize THEN {
                colors: LIST OF IIColorMap.MapEntry _ data.mapEntries;
                mapScale: NAT _ 1;
                IF specialTwoBits AND data.frame.refRep.lgBitsPerPixel=1 THEN {
                    mapScale _ 2;
                    FOR m: LIST OF IIColorMap.MapEntry _ colors, m.rest UNTIL m = NIL DO
                        r: NAT _ 255;
                        g: NAT _ 255;
                        b: NAT _ 255;
                        IF m.first.red # 0 THEN {
                            g _ g-1;
                            b _ b-1;
                            };
                        IF m.first.green # 0 THEN {
                            r _ r-1;
                            b _ b-1;
                            };
                        IF m.first.blue # 0 THEN {
                            r _ r-1;
                            g _ g-1;
                            };
                        colors _ CONS[[m.first.mapIndex+4, r, g, b], colors];
                        ENDLOOP;
                    };
                IF colors = NIL THEN ERROR;
                table _ IIDither.CreateTable[packing: packing, sTileSize: sTileSize, fTileSize: fTileSize];
                IIDither.InitTable[table, colors, mapScale];
                FunctionCache.Insert[cache, data.mapEntries, table, INT[256]*256, me];
                };
            data.table _ table;
            };
        };

    SetUpSampledColorData: PROC [data: Data] ~ {
        cache: FunctionCache.Cache _ FunctionCache.GlobalCache[];
        color: SampledColor ~ data.sampledColor;
        pa: PixelArray ~ color.pa;
        compare: FunctionCache.CompareProc ~ {RETURN [argument=pa]};
        scd: SampledColorData _ NARROW[FunctionCache.Lookup[cache, compare, me].value];
        IF color = NIL THEN ERROR;
        IF scd = NIL OR scd.packing # packing THEN TRUSTED {
            pa: PixelArray ~ color.pa;
            colorOperator: ColorOperator ~ color.colorOperator;
            samplesPerPixel: NAT ~ pa.samplesPerPixel;
            sSize: NAT ~ pa.sSize;
            fSize: NAT ~ pa.fSize;
            maxIn: Sample ~ IIPixelArray.MaxSampleValue[pa, 0];
            pixels: SampleBuffer ~ IISample.NewBuffer[samplesPerPixel, fSize];
            buffer: SampleBuffer ~ IISample.NewBuffer[3, fSize];
            bufferPointerR: UnsafeSamples ~ buffer.GetPointer[0, 0, fSize];
            bufferPointerG: UnsafeSamples ~ buffer.GetPointer[1, 0, fSize];
            bufferPointerB: UnsafeSamples ~ buffer.GetPointer[2, 0, fSize];
            mapperR: IIColorOperator.Mapper ~ IIColorOperator.NewMapper[
            op: colorOperator, component: $Red, maxIn: maxIn, maxOut: 255];
            mapperG: IIColorOperator.Mapper ~ IIColorOperator.NewMapper[
            op: colorOperator, component: $Green, maxIn: maxIn, maxOut: 255];
            mapperB: IIColorOperator.Mapper ~ IIColorOperator.NewMapper[
            op: colorOperator, component: $Blue, maxIn: maxIn, maxOut: 255];
            t: IIPixelMap.PixelMap ~ IIPixelMap.Create[4, [0, 0, sSize, fSize]];
            line: LONG POINTER TO Basics.RawWords _ t.refRep.pointer;
            rast: NAT ~ t.refRep.rast;
            sampledColorDataSize: INT _ t.refRep.words+SIZE[IIPixelMap.PixelMap]+SIZE[IIPixelMap.PixelMapRep];
            scd _ NEW[SampledColorDataRep _ [packing, t]];
            FOR s: NAT IN[0..sSize) DO
                IIPixelArray.GetPixels[pa: pa, s: s, f: 0, buffer: pixels, count: fSize];
                IIColorOperator.MapPixels[mapper: mapperR, pixels: pixels, 
                buffer: buffer, bi: 0, count: fSize];
                IIColorOperator.MapPixels[mapper: mapperG, pixels: pixels, 
                buffer: buffer, bi: 1, count: fSize];
                IIColorOperator.MapPixels[mapper: mapperB, pixels: pixels, 
                buffer: buffer, bi: 2, count: fSize];
                IIDither.PackSequence[dest: line, red: bufferPointerR, green: bufferPointerG, blue: bufferPointerB, count: fSize, packing: packing];
                line _ line + rast;
                ENDLOOP;
            FunctionCache.Insert[cache, pa, scd, sampledColorDataSize, me];
            };
        data.sampledColorData _ scd;
        };

    DitheredMaskBoxesInternal: PROC[data: Data, bounds: DeviceBox, boxes: PROC[BoxProc]] ~ {
        ditheredBox: PROC[box: DeviceBox] ~ {
            runs: PROC[run: RunProc] ~ { IIMask.RunsFromBox[box: box, run: run] };
            DitheredMaskRunsInternal[data: data, bounds: box, runs: runs];
            };
        boxes[ditheredBox];
        };

    lockingCursor: BOOL _ TRUE;

    ModifyColorFrame: PROC [vt: Terminal.Virtual, action: PROC, xmin: NAT, ymin: NAT, xmax: NAT, ymax: NAT] ~ INLINE {
        IF vt = NIL OR NOT lockingCursor THEN action[]
        ELSE Terminal.ModifyColorFrame[vt: vt, action: action, xmin: xmin, ymin: ymin, xmax: xmax, ymax: ymax];
        };

    DitheredMaskRuns: PROC[device: Device, bounds: DeviceBox, runs: PROC[RunProc]] ~ {
        data: Data ~ NARROW[device.data];
        ditheredMaskRunsAction: PROC ~ { DitheredMaskRunsInternal[data, bounds, runs] };
        ModifyColorFrame[vt: data.terminal, action: ditheredMaskRunsAction,
        xmin: bounds.fmin, ymin: bounds.smin, xmax: bounds.fmax, ymax: bounds.smax];
        };

    DitheredMaskBoxes: PROC[device: Device, bounds: DeviceBox, boxes: PROC[BoxProc]] ~ {
        data: Data ~ NARROW[device.data];
        ditheredMaskBoxesAction: PROC ~ { DitheredMaskBoxesInternal[data, bounds, boxes] };
        ModifyColorFrame[vt: data.terminal, action: ditheredMaskBoxesAction,
        xmin: bounds.fmin, ymin: bounds.smin, xmax: bounds.fmax, ymax: bounds.smax];
        };

    DitheredMaskBits: PROC[device: Device, srcBase: LONG POINTER, srcWordsPerLine: NAT, 
    ts, tf: INTEGER, boxes: PROC[BoxProc]] ~ {
        data: Data ~ NARROW[device.data];
        ditheredMaskBitsBox: PROC[box: DeviceBox] ~ {
            ditheredMaskBitsBoxAction: PROC ~ {
                runs: PROC[run: RunProc] ~ { IIMask.RunsFromBits[
                base: srcBase, wordsPerLine: srcWordsPerLine, 
                sBits: box.smin-ts, fBits: box.fmin-tf, sRuns: box.smin, fRuns: box.fmin, 
                sSize: box.smax-box.smin, fSize: box.fmax-box.fmin, run: run];
                    };
                DitheredMaskRunsInternal[data: data, bounds: box, runs: runs];
                };
            ModifyColorFrame[vt: data.terminal, action: ditheredMaskBitsBoxAction,
            xmin: box.fmin, ymin: box.smin, xmax: box.fmax, ymax: box.smax];
            };
        boxes[ditheredMaskBitsBox];
        };

    DitheredMoveBoxes: PROC [device: Device, ts, tf: INTEGER, boxes: PROC[BoxProc]] ~ TRUSTED {
        data: Data ~ NARROW[device.data];
        frame: PixelMap ~ data.frame;
        base: LONG POINTER ~ frame.refRep.pointer;
        wordsPerLine: NAT ~ frame.refRep.rast;
        lgBitsPerPixel: NAT ~ frame.refRep.lgBitsPerPixel;
        bitsPerPixel: NAT ~ Basics.BITSHIFT[1, lgBitsPerPixel];
        heightLimit: NAT ~ frame.sMin+frame.sSize;
        widthLimit: NAT ~ frame.fMin+frame.fSize;
        bbspace: PrincOps.BBTableSpace;
        bb: PrincOps.BitBltTablePtr ~ PrincOpsUtils.AlignedBBTable[@bbspace];
        action: SAFE PROC ~ TRUSTED { PrincOpsUtils.BITBLT[bb] };
        moveBox: PROC[box: DeviceBox] ~ TRUSTED {
            dfmin: NAT ~ Check[box.fmin, widthLimit];
            dsmin: NAT ~ Check[box.smin, heightLimit];
            dfmax: NAT ~ Check[box.fmax, widthLimit];
            dsmax: NAT ~ Check[box.smax, heightLimit];
            sfmin: NAT ~ dfmin-tf;
            ssmin: NAT ~ dsmin-ts;
            sfmax: NAT ~ dfmax-tf;
            ssmax: NAT ~ dsmax-ts;
            dstBit: CARDINAL ~ Basics.BITSHIFT[dfmin, lgBitsPerPixel];
            srcBit: CARDINAL ~ Basics.BITSHIFT[sfmin, lgBitsPerPixel];
            bpl: INTEGER _ wordsPerLine*bitsPerWord;
            ss: NAT _ ssmin;
            ds: NAT _ dsmin;
            bb.flags _ [disjoint: TRUE, disjointItems: TRUE, direction: forward, gray: FALSE];
            IF dsmin<ssmax AND dsmax>ssmin THEN {
            bb.flags.disjoint _ FALSE;
                IF dsmin=ssmin AND dfmin<sfmax AND dfmax>sfmin THEN bb.flags.disjointItems _ FALSE;
                IF dsmin>ssmin OR (dsmin=ssmin AND dfmin>sfmin) THEN {
                bb.flags.direction _ backward; bpl _ -bpl; ss _ ssmax-1; ds _ dsmax-1;
                    };
                };
            bb.dst.word _ base+Basics.LongMult[ds, wordsPerLine]+dstBit/bitsPerWord;
            bb.dst.bit _ dstBit MOD bitsPerWord;
            bb.dstBpl _ bpl;
            bb.src.word _ base+Basics.LongMult[ss, wordsPerLine]+srcBit/bitsPerWord;
            bb.src.bit _ srcBit MOD bitsPerWord;
            bb.srcDesc.srcBpl _ bpl;
            bb.width _ (dfmax-dfmin)*bitsPerPixel;
            bb.height _ dsmax-dsmin;
            ModifyColorFrame[vt: data.terminal, action: action,
            xmin: MIN[dfmin, sfmin], ymin: MIN[dsmin, ssmin], 
            xmax: MAX[dfmax, sfmax], ymax: MAX[dsmax, ssmax]];
            };
        bb^ _ nullBitBltTable;
        boxes[moveBox];
        };

    SpecialPixel: TYPE ~ IIDitheredDevice.SpecialPixel;

    specialStipple: WORD _ 0E280H;
    ColorFromSpecialPixel: PUBLIC PROC [specialPixel: SpecialPixel] RETURNS [ConstantColor] ~ {
        impl: ConstantColorImpl ~ NEW[ConstantColorImplRep.stipple _ [
        Y: 0.7, variant: stipple[word: 0E280H, function: replace]]];
        RETURN[NEW[IIColorDefs.ColorRep.constant _ [variant: constant[impl: impl, data: NEW[SpecialPixel_specialPixel]]]]];
        };

    IntensityFromRGB: PROC [val: IIColor.RGB] RETURNS [REAL] ~ {
        Y: REAL ~ 0.30*val.R+0.59*val.G+0.11*val.B;
        IF Y<=0 THEN RETURN[0];
        IF Y>=1 THEN RETURN[1];
        RETURN[Y];
        };

    ColorFromSpecialRGB: PUBLIC PROC [specialPixel: SpecialPixel, rgb: IIColor.RGB] RETURNS [ConstantColor] ~ {
        impl: ConstantColorImpl ~ NEW[ConstantColorImplRep.rgb _ [
        Y: IntensityFromRGB[rgb], variant: rgb[val: rgb]]];
        RETURN[NEW[IIColorDefs.ColorRep.constant _ [variant: constant[impl: impl, data: NEW[SpecialPixel_specialPixel]]]]];
        };
    <<>>
    END.