
    <<IIMaskCaptureImpl.mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Michael Plass, December 10, 1986 12:03:59 pm PST>>

DIRECTORY
Basics USING [bitsPerWord, CARD, LongMult],
II USING [ConcatT, Context, DoSave, DoSaveAll, PathProc, PixelArray, SetColor, SetFont, SetXY],
IIBackdoor USING [Clipper, IntKey, RealKey, SetInt, SetReal, ViewTranslateI],
IIBox USING [Box, BoxFromExtents, Rectangle],
IIColor USING [Color, ColorOperator, ColorRep, SpecialColor],
IIDevice USING [AllowedMasks, DeviceClass, DeviceClassRep, DeviceParm, DeviceParmRep, FontTuner],
IIFont,
IIManhattan USING [BoundingBox, CreateFromBoxes, Destroy, DestructiveUnion, Map, Polygon, Shift],
IIMaskCache USING [CharMask, CharMaskRep],
IIMaskCapture USING [],
IIPrivate USING [Class],
IIRaster USING [Create, CreateClass, SetDeviceClipBox],
IISample USING [Clear, Fill, NewSampleMap, ObtainUnsafeDescriptor, ReleaseDescriptor, SampleMap, WordsForMap],
IIState USING [StateGetFont, StateGetInt, StateGetReal, StateSpace],
IITransformation USING [Transformation],
IITypeface USING [MaskChar],
Real USING [LargestNumber, Round],
Scaled USING [FromReal],
SF USING [Box, BoxAction, BoxGenerator, Displace, Max, maxVec, Min, minVec, Size, SizeF, SizeS],
Vector2 USING [VEC];

    IIMaskCaptureImpl: CEDAR MONITOR
    IMPORTS Basics, II, IIBackdoor, IIBox, IIFont, IIManhattan, IIRaster, IISample, IIState, IITypeface, Real, Scaled, SF
    EXPORTS IIMaskCapture
    ~ BEGIN

        smallestBitmap: NAT _ 10;
            <<All CharMask rasters will be at least this big, in an attempt to improve locality.>>

        CharMask: TYPE ~ IIMaskCache.CharMask;
        CharMaskRep: TYPE ~ IIMaskCache.CharMaskRep;
        Clipper: TYPE ~ IIBackdoor.Clipper;
        Color: TYPE ~ IIColor.Color;
        Context: TYPE ~ II.Context;
        CorrectionType: TYPE ~ IIFont.CorrectionType;
        Font: TYPE ~ IIFont.Font;
        IntKey: TYPE ~ IIBackdoor.IntKey;
        PathProc: TYPE ~ II.PathProc;
        PixelArray: TYPE ~ II.PixelArray;
        RealKey: TYPE ~ IIBackdoor.RealKey;
        Rectangle: TYPE ~ IIBox.Rectangle;
        SampleMap: TYPE ~ IISample.SampleMap;
        Transformation: TYPE ~ IITransformation.Transformation;
        VEC: TYPE ~ Vector2.VEC;
        XChar: TYPE ~ IIFont.XChar;


        viewOrigin: NAT ~ 10000;
            <<The view origin away from the origin of device coords.>>
            <<Smaller than 16K to hit integerTrans often.>>

        maxSize: REAL ~ 1200.0;
            <<If the bounding box exceeds this, we won't try to cache the mask in any form, but we may still cache the bounding box and 
            escapement.>>

        unsetColor: IIColor.SpecialColor ~ NEW[IIColor.ColorRep.special _ [special[type: $Unset, data: NIL, substitute: NIL]]];

        Data: TYPE ~ REF DataRep;
        DataRep: TYPE ~ RECORD [
            boundsOnly: BOOL _ FALSE,
            checkColor: BOOL _ FALSE,
            bounds: SF.Box _ [],
            boxes: IIManhattan.Polygon _ NIL
            ];

        nullReal: REAL ~ Real.LargestNumber;

        Cant: PUBLIC SIGNAL [why: ATOM] ~ CODE;

        CreateContext: PROC RETURNS [Context] ~ {
            data: Data ~ NEW [DataRep _ []];
            deviceParm: IIDevice.DeviceParm _ NEW [IIDevice.DeviceParmRep _ [
                class: deviceClass,
                sSize: INTEGER.LAST,
                fSize: INTEGER.LAST,
                scanMode: [slow: right, fast: up],
                surfaceUnitsPerInch: [1,1],
                surfaceUnitsPerPixel: 1,
                fontTuner: NIL,
                fontCache: NIL,
                rastWeight: 0.0
                ]];
            context: Context ~ IIRaster.Create[class: contextClass, deviceParm: deviceParm, data: data, pixelUnits: TRUE];
            IIRaster.SetDeviceClipBox[context, [max: [INTEGER.LAST, INTEGER.LAST]]];
            IIBackdoor.ViewTranslateI[context, viewOrigin, viewOrigin];
            FOR key: IntKey IN IntKey[strokeEnd..strokeJoint] DO
                IIBackdoor.SetInt[context, key, INT.LAST];
                ENDLOOP;
            FOR key: RealKey IN RealKey[mediumXSize..correctTY] DO
                IIBackdoor.SetReal[context, key, nullReal];
                ENDLOOP;
            II.SetColor[context, unsetColor];
            II.SetFont[context, NIL];
            II.SetXY[context, [0, 0]];
            RETURN [context]
            };
<<Context Cache>>
    GetContext: PROC RETURNS [context: Context] ~ INLINE {
    context _ TryGetContext[];
    IF context = NIL THEN context _ CreateContext[];
    };

    c1: Context _ NIL;
    c2: Context _ NIL;
    TryGetContext: ENTRY PROC RETURNS [context: Context] ~ INLINE {
    IF c1#NIL THEN {context _ c1; c1 _ NIL}
    ELSE IF c2#NIL THEN {context _ c2; c2 _ NIL}
    ELSE context _ NIL;
    };

    FreeContext: ENTRY PROC [context: Context] ~ INLINE {
    IF c1=NIL THEN {c1 _ context} ELSE c2 _ context;
    };

<<Public Procs>>

    CaptureChar: PUBLIC PROC [font: Font, char: XChar, ratio: REAL, fontTuner: IIDevice.FontTuner _ NIL, metricsOnly: BOOL _ FALSE] 
    RETURNS [charMask: CharMask _ NIL] ~ {
        escapement: VEC ~ IIFont.Escapement[font, char];
        bounds: IIBox.Box ~ IIBox.BoxFromExtents[IIFont.BoundingBox[font, char]];
        Operator: PROC [context: Context] ~ {
            IITypeface.MaskChar[font, char, context];
            };
        TunedOperator: PROC [context: Context] ~ {
            fontTuner.proc[fontTuner, Operator, context];
            };
        IF ABS[escapement.x] <= 16383.0 AND ABS[escapement.y] <= 16383.0 AND bounds.xmin >= -viewOrigin AND bounds.ymin >= -viewOrigin AND 
        bounds.xmax <= LAST[INTEGER]-viewOrigin AND bounds.ymax <= LAST[INTEGER]-viewOrigin THEN {
            p: IIManhattan.Polygon _ NIL;
            ok: BOOL _ TRUE;
            IF metricsOnly OR bounds.xmax-bounds.xmin > maxSize OR bounds.ymax-bounds.ymin > maxSize
                THEN ok _ FALSE
                ELSE p _ CaptureManhattan[operator: IF fontTuner = NIL THEN Operator ELSE TunedOperator, m: NIL, checkColor: TRUE ! Cant => {ok _ 
                FALSE; CONTINUE}];
            IF ok THEN {
            bb: SF.Box ~ IIManhattan.BoundingBox[p];
            bitmapWords: REAL ~ IISample.WordsForMap[size: SF.Size[bb], bitsPerSample: 1];
            nRuns: INT ~ CountRuns[p];
            charMask _ (
            IF nRuns*2*ratio >= bitmapWords THEN RasterCharMaskFromManhattan[p, bb]
            ELSE RunsCharMaskFromManhattan[p, bb, nRuns]);
                };
            IIManhattan.Destroy[p];
            IF charMask = NIL THEN {
                IF metricsOnly
                    THEN charMask _ NEW[CharMaskRep.culled]
                    ELSE charMask _ NEW[CharMaskRep.maskNotCacheable];
                charMask.box _ [min: [Floor[bounds.xmin], Floor[bounds.ymin]], max: [Ceiling[bounds.xmin], Ceiling[bounds.ymin]]];
                };
            charMask.font _ font;
            charMask.char _ char;
            charMask.escapement.s _ Scaled.FromReal[escapement.x];
            charMask.escapement.f _ Scaled.FromReal[escapement.y];
            charMask.amplified _ IIFont.Amplified[font, char];
            charMask.correction _ IIFont.Correction[font, char];
            };
        };

CaptureBounds: PUBLIC PROC [operator: PROC [Context], m: Transformation] RETURNS [box: SF.Box] ~ {
    context: Context ~ GetContext[];
    data: Data ~ NARROW[context.data];
    proc: PROC ~ { II.ConcatT[context, m]; operator[context] };
    data.boundsOnly _ TRUE;
    data.checkColor _ FALSE;
    data.bounds _ [min: SF.maxVec, max: SF.minVec];
    II.DoSaveAll[context, proc];
    box _ SF.Displace[data.bounds, [-viewOrigin, -viewOrigin]];
    FreeContext[context];
    };

    CaptureBoxes: PUBLIC PROC [operator: PROC [Context], m: Transformation, boxAction: SF.BoxAction, checkColor: BOOL] ~ {
        p: IIManhattan.Polygon ~ CaptureManhattan[operator, m, checkColor];
        FOR each: LIST OF SF.Box _ p, each.rest UNTIL each = NIL DO
            boxAction[each.first];
            ENDLOOP;
        IIManhattan.Destroy[p];
        };

    CaptureBitmap: PUBLIC PROC [operator: PROC [Context], m: Transformation, checkColor: BOOL] RETURNS [SampleMap] ~ {
        p: IIManhattan.Polygon ~ CaptureManhattan[operator, m, checkColor];
        bitmap: SampleMap ~ IISample.NewSampleMap[IIManhattan.BoundingBox[p]];
        IISample.Clear[bitmap];
        FOR each: LIST OF SF.Box _ p, each.rest UNTIL each = NIL DO
            IISample.Fill[map: bitmap, box: each.first, value: 1];
            ENDLOOP;
        IIManhattan.Destroy[p];
        RETURN [bitmap]
        };

    CaptureManhattan: PUBLIC PROC [operator: PROC [Context], m: Transformation, checkColor: BOOL] RETURNS [p: IIManhattan.Polygon _ 
    NIL] ~ {
        context: Context ~ GetContext[];
        data: Data ~ NARROW[context.data];
        proc: PROC ~ { II.ConcatT[context, m]; operator[context] };
        data.boundsOnly _ FALSE;
        data.checkColor _ checkColor;
        data.bounds _ [min: SF.maxVec, max: SF.minVec];
        data.boxes _ NIL;
        II.DoSaveAll[context, proc];
        IIManhattan.Shift[data.boxes, -viewOrigin, -viewOrigin];
        p _ data.boxes;
        data.boxes _ NIL;
        FreeContext[context];
        };

<<Support Procs>>
Floor: PROC [r: REAL] RETURNS [i: INT] ~ INLINE {
i _ Real.Round[r];
IF i > r THEN i _ i - 1;
};

Ceiling: PROC [r: REAL] RETURNS [i: INT] ~ INLINE {
i _ Real.Round[r];
IF i < r THEN i _ i + 1;
};

    RasterCharMaskFromManhattan: PROC [p: IIManhattan.Polygon, bb: SF.Box] RETURNS [REF CharMaskRep.raster] ~ {
    rast: NAT ~ (SF.SizeF[bb]+(Basics.bitsPerWord-1))/Basics.bitsPerWord;
    bitmapWords: LONG CARDINAL ~ Basics.LongMult[SF.SizeS[bb], rast];
    IF bitmapWords > NAT.LAST-10-SIZE[CharMaskRep.raster[0]]
    THEN RETURN [NIL]
        ELSE TRUSTED {
            mask: REF CharMaskRep.raster _ NEW[CharMaskRep.raster[MAX[NAT[bitmapWords], smallestBitmap]]];
            bits: SampleMap ~ IISample.ObtainUnsafeDescriptor[size: SF.Size[bb],
            bitsPerSample: 1, bitsPerLine: rast*Basics.bitsPerWord,
            base: [word: @mask[0], bit: 0], ref: mask, words: bitmapWords, delta: bb.min];
            mask.flag _ ALL[0];
            mask.box _ bb;
        WHILE p # NIL DO
        IISample.Fill[bits, p.first, 1];
        p _ p.rest;
        ENDLOOP;
            IISample.ReleaseDescriptor[bits];
            RETURN [mask];
            };
    };

    RunsCharMaskFromManhattan: PROC [p: IIManhattan.Polygon, bb: SF.Box, nRuns: INT] RETURNS [mask: REF CharMaskRep.runs] ~ {
    i: NAT _ 0;
    s: NAT _ 0;
    AppendRun: PROC [box: SF.Box] ~ {
    check: [1..1] ~ SF.SizeS[box];
    smin: NAT ~ box.min.s-bb.min.s;
    fmin: NAT ~ box.min.f-bb.min.f;
    IF smin # s THEN {
    mask[i-1].lastRun _ TRUE;
    s _ s + 1;
    WHILE smin > s DO
    mask[i] _ [fMin: 0, lastRun: TRUE, fSize: 0];
    i _ i + 1;
    s _ s + 1;
    ENDLOOP;
    };
    mask[i] _ [fMin: fmin, lastRun: FALSE, fSize: SF.SizeF[box]];
    i _ i + 1;
    };
    IF nRuns = 0 OR nRuns > 4000 THEN RETURN [NIL];
    mask _ NEW[CharMaskRep.runs[nRuns]];
    mask.flag _ ALL[0];
    mask.box _ bb;
    IIManhattan.Map[polygon: p, boxAction: AppendRun, runs: TRUE];
    IF i#nRuns THEN ERROR;
    IF CARDINAL[s]+1 # SF.SizeS[mask.box] THEN ERROR;
    mask[i-1].lastRun _ TRUE;
    };

    CountRuns: PROC [p: IIManhattan.Polygon] RETURNS [runs: INT _ 0] ~ {
        <<This version includes zero-length runs needed to get the PD run representation to work.>>
        s: INTEGER _ IF p # NIL THEN p.first.min.s ELSE 0;
        WHILE p # NIL DO
            sMin: INTEGER ~ p.first.min.s;
            sSize: NAT ~ SF.SizeS[p.first];
            IF sMin > s THEN {runs _ runs + (sMin - s)};
            s _ sMin + sSize;
            runs _ runs + sSize;
            p _ p.rest;
            ENDLOOP;
        };

<<Device Class Procs>>
    CaptureSetColor: PROC [context: Context, color: Color, viewToDevice: Transformation] RETURNS [IIDevice.AllowedMasks] ~ {
        data: Data ~ NARROW[context.data];
        IF data.checkColor AND color # unsetColor THEN SIGNAL Cant[$SetColor];
        RETURN [[unorderedBoxes: FALSE, regionFill: FALSE, bitmap: FALSE, rawBitmaps: FALSE, runGroupChar: FALSE, rasterChar: FALSE]];
        };

    CaptureMaskBoxes: PROC [context: Context, bounds: SF.Box, boxes: SF.BoxGenerator] ~ {
        data: Data ~ NARROW[context.data];
        data.bounds _ [min: SF.Min[data.bounds.min, bounds.min], max: SF.Max[data.bounds.max, bounds.max]];
        IF NOT data.boundsOnly THEN {
            new: IIManhattan.Polygon ~ IIManhattan.DestructiveUnion[IIManhattan.CreateFromBoxes[boxes], data.boxes];
            IIManhattan.Destroy[data.boxes];
            data.boxes _ new;
            };
        };

<<Context Class Procs>>
    MySetT: PROC [context: Context, m: Transformation] ~ {SIGNAL Cant[$SetT]};

    MyGetInt: PROC [context: Context, key: IntKey] RETURNS [INT] ~ {
        i: INT ~ IIState.StateGetInt[context, key];
        IF i = INT.LAST THEN SIGNAL Cant[$UninitializedState];
        RETURN [i]
        };

    MyGetReal: PROC [context: Context, key: RealKey] RETURNS [REAL] ~ {
        r: REAL ~ IIState.StateGetReal[context, key];
        IF r = nullReal THEN SIGNAL Cant[$UninitializedState];
        IF key = DCScpx OR key = DCScpy THEN SIGNAL Cant[$GetDCScp];
        RETURN [r]
        };

    MyGetFont: PROC [context: Context] RETURNS [Font] ~ {
        font: Font ~ IIState.StateGetFont[context];
        IF font = NIL THEN SIGNAL Cant[$UninitializedState];
        RETURN [font];
        };

    MyGetColor: PROC [context: Context] RETURNS [Color] ~ {
        ERROR Cant[$GetColor]
        };

    MyGetClipper: PROC [context: Context] RETURNS [Clipper] ~ {
        ERROR Cant[$GetClipper]
        };

    MySpace: PROC [context: Context, x: REAL] ~ {
        IF IIState.StateGetReal[context, amplifySpace] = nullReal THEN ERROR Cant[$UninitializedState];
        IIState.StateSpace[context, x];
        };

    RasterShow: PROC [context: Context, string: IIFont.XStringProc, xrel: BOOL] _ NIL;
    MyShow: PROC [context: Context, string: IIFont.XStringProc, xrel: BOOL] ~ {
        IF IIState.StateGetFont[context] = NIL THEN ERROR Cant[$UninitializedState];
        RasterShow[context, string, xrel];
        };

    RasterMaskUnderline: PROC [context: Context, dy: REAL, h: REAL] _ NIL;
    MyMaskUnderline: PROC [context: Context, dy: REAL, h: REAL] ~ {
        IF IIState.StateGetReal[context, underlineStart] = nullReal THEN ERROR Cant[$UninitializedState];
        RasterMaskUnderline[context, dy, h];
        };

    MyCorrect: PROC [context: Context, action: PROC] ~ {
        SIGNAL Cant[$Correct];
        II.DoSaveAll[context, action];
        };

    MyDontCorrect: PROC [context: Context, action: PROC, saveCP: BOOL] ~ {
        SIGNAL Cant[$Correct];
        IF saveCP THEN II.DoSaveAll[context, action] ELSE II.DoSave[context, action];
        };

    RasterMaskStroke: PROC [context: Context, path: PathProc, closed: BOOL] _ NIL;
    MyMaskStroke: PROC [context: Context, path: PathProc, closed: BOOL] ~ {
        IF IIState.StateGetInt[context, strokeEnd] = INT.LAST OR IIState.StateGetInt[context, strokeJoint] = INT.LAST OR 
        IIState.StateGetReal[context, strokeWidth] = nullReal THEN ERROR Cant[$UninitializedState];
        RasterMaskStroke[context, path, closed];
        };

    MyGetBounds: PROC [context: Context] RETURNS [Rectangle] ~ {ERROR Cant[$GetBounds]};

    deviceClass: IIDevice.DeviceClass  ~ NEW[IIDevice.DeviceClassRep _ [
        SetColor: CaptureSetColor,
        MaskBoxes: CaptureMaskBoxes
        ]];

    contextClass: IIPrivate.Class ~ MakeClass[];
    MakeClass: PROC RETURNS [IIPrivate.Class] ~ {
        new: IIPrivate.Class ~ IIRaster.CreateClass[type: $Capture, deviceClass: deviceClass];
        new.SetT _ MySetT;
        new.GetInt _ MyGetInt;
        new.GetReal _ MyGetReal;
        new.GetFont _ MyGetFont;
        new.GetColor _ MyGetColor;
        new.GetClipper _ MyGetClipper;
        new.Space _ MySpace;
        RasterMaskUnderline _ new.MaskUnderline;
        new.MaskUnderline _ MyMaskUnderline;
        RasterShow _ new.Show;
        new.Show _ MyShow;
        new.Correct _ MyCorrect;
        new.DontCorrect _ MyDontCorrect;
        RasterMaskStroke _ new.MaskStroke;
        new.MaskStroke _ MyMaskStroke;
        new.GetBounds _ MyGetBounds;
        RETURN [new]
        };


    END.