
<<ImagerMemoryImpl.mesa>>
    <<Copyright © 1984, 1985, 1986 Xerox Corporation.  All rights reserved.>>
<<Eric Nickell, July 17, 1985 5:03:14 pm PDT>>
    <<Michael Plass, September 24, 1985 4:09:33 pm PDT>>
    <<Pier, October 8, 1985 2:28:23 pm PDT>>
<<Doug Wyatt, May 30, 1986 7:16:30 pm PDT>>

DIRECTORY
    Basics, CountedVM, Imager, ImagerBackdoor, ImagerColorOperator, ImagerExtras, ImagerFont, ImagerMemory, ImagerPath, ImagerPrivate, 
    ImagerTransformation, PrincOpsUtils, Rope;


    ImagerMemoryImpl: CEDAR PROGRAM
    IMPORTS Basics, CountedVM, Imager, ImagerBackdoor, ImagerColorOperator, ImagerExtras, ImagerFont, ImagerTransformation, 
    PrincOpsUtils, Rope
    EXPORTS Imager, ImagerMemory
    SHARES Rope -- For QFetch
    ~ BEGIN
    OPEN Imager;

IntKey: TYPE ~ ImagerBackdoor.IntKey;
RealKey: TYPE ~ ImagerBackdoor.RealKey;
Clipper: TYPE ~ ImagerBackdoor.Clipper;

    firstMemForm: NAT ~ 1000;
    endMemForm: NAT ~ 2000;

Data: TYPE ~ REF DataRep;
DataRep: TYPE ~ RECORD[head, tail: CommandList, getTDone: BOOL _ FALSE, getTForm: NAT _ firstMemForm];

Class: TYPE ~ ImagerPrivate.Class;
ClassRep: PUBLIC TYPE ~ ImagerPrivate.ClassRep;    --export to Imager

CommandList: TYPE ~ LIST OF CommandRep;
    checkSize: [0..5] ~ SIZE[CommandRep]; -- want to keep the size of CommandRep small.
    CommandRep: TYPE ~ RECORD[SELECT type: * FROM
        DoSave => [body: CommandList, all: BOOL],
        SetInt => [key: IntKey, val: INT],
        SetReal => [key: RealKey, val: REAL],
        SetT => [m: Transformation],
        SetFont => [font: Font],
        SetColor => [color: Color],
        SetClipper => [clipper: Clipper],
        ConcatT => [m: Transformation],
        Scale2T => [s: VEC],
        RotateT => [a: REAL],
        TranslateT => [t: VEC],
        Move => [rounded: BOOL],
        SetXY => [p: VEC],
        SetXYRel => [v: VEC],
        Show => [string: XStringSeq, xrel: BOOL],
        ShowShort => [text: Rope.Text, xrel: BOOL],
        StartUnderline => [],
        MaskUnderline => [dy, h: REAL],
        CorrectMask => [],
        CorrectSpace => [v: VEC],
        Space => [x: REAL],
        SetCorrectMeasure => [v: VEC],
        SetCorrectTolerance => [v: VEC],
        Correct => [body: CommandList],
        DontCorrect => [body: CommandList, saveCP: BOOL],
        SetGray => [f: REAL],
        SetSampledColor => [d: REF SetSampledColorData],
        SetSampledBlack => [d: REF SetSampledBlackData],
        MaskFill => [path: Path, oddWrap: BOOL],
        MaskRectangle => [r: REF Rectangle],
        MaskRectangleI => [x, y, w, h: INTEGER],
        MaskStroke => [path: Path, closed: BOOL],
        MaskVector => [p: REF ARRAY [0..2) OF VEC],
        MaskDashedStroke => [d: REF MaskDashedStrokeData],
        MaskPixel => [pa: PixelArray],
        MaskBits => [bits: Bits],
        DrawBits => [bits: Bits],
        Clip => [path: Path, oddWrap: BOOL, exclude: BOOL],
        ClipRectangle => [r: REF Rectangle, exclude: BOOL]
        ENDCASE
        ];

    SetSampledColorData: TYPE ~ RECORD [
        pa: PixelArray,
        m: Transformation,
        colorOperator: ColorOperator
        ];

    SetSampledBlackData: TYPE ~ RECORD [
        pa: PixelArray,
        m: Transformation,
        clear: BOOL
        ];

    MaskDashedStrokeData: TYPE ~ RECORD [
    path: Path,
    pattern: REF PatternSequence,
    offset: REAL,
    length: REAL
        ];

    PatternSequence: TYPE ~ RECORD [SEQUENCE patternLen: NAT OF REAL];

    XStringSeq: TYPE ~ REF XStringSeqRec;
    XStringSeqRec: TYPE ~ RECORD [
        SEQUENCE n: CARDINAL OF XChar
        ];

    Path: TYPE ~ REF PointSequence;
    PointSequence: TYPE ~ RECORD [
        rest: REF PointSequence _ NIL,
        seq: SEQUENCE k: NAT OF PointRec
        ];

    PointRec: TYPE ~ RECORD [SELECT type: * FROM
        move => [p0: VEC],
        line => [p1: VEC],
        push => [p: VEC],
        curve => [p3: VEC], -- preceeded by two pushes
        conic => [r: REAL], -- preceeded by two pushes
        arc => [p2: VEC] -- preceeded by one push
        ENDCASE
        ];
<<Utility Procedures>>
    DoPath: PROC [path: Path, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, curveTo: ImagerPath.CurveToProc, conicTo: 
    ImagerPath.ConicToProc, arcTo: ImagerPath.ArcToProc] ~ {
        stack: ARRAY [0..2) OF VEC;
        s: [0..2] _ 0;
        UNTIL path = NIL DO
            FOR i: NAT IN [0..path.k) DO
                pointRec: PointRec ~ path[i];
                WITH x: pointRec SELECT FROM
                    move => {check: [0..0] ~ s; moveTo[x.p0]};
                    line => {check: [0..0] ~ s; lineTo[x.p1]};
                    push => {stack[s] _ x.p; s _ s+1};
                    curve => {check: [2..2] ~ s; curveTo[stack[0], stack[1], x.p3]; s _ 0};
                    conic => {check: [2..2] ~ s; conicTo[stack[0], stack[1], x.r]; s _ 0};
                    arc => {check: [1..1] ~ s; arcTo[stack[0], x.p2]; s _ 0};
                    ENDCASE => ERROR;
                ENDLOOP;
            path _ path.rest;
            ENDLOOP;
        };
    GetPath: PROC [pathProc: PathProc] RETURNS [path: Path] ~ {
        bufSize: NAT ~ 40;
        buf: ARRAY [0..bufSize) OF PointRec;
        k: NAT _ 0;
        Flush: PROC ~ {
            rest: REF PointSequence _ NEW[PointSequence[k]];
            FOR i: NAT IN [0..k) DO
                TRUSTED {rest[i] _ buf[i]};
                ENDLOOP;
            IF pathTail = NIL THEN path _ rest ELSE pathTail.rest _ rest;
            pathTail _ rest;
            k _ 0;
            };
        AppendToPath: PROC [pointRec: PointRec] ~ {
            IF k = bufSize THEN Flush[];
            TRUSTED {buf[k] _ pointRec};
            k _ k + 1;
            };
        MoveTo: ImagerPath.MoveToProc ~ {
            AppendToPath[[move [p]]]
            };
        LineTo: ImagerPath.LineToProc ~ {
            AppendToPath[[line [p1]]]
            };
        CurveTo: ImagerPath.CurveToProc ~ {
            AppendToPath[[push [p1]]];
            AppendToPath[[push [p2]]];
            AppendToPath[[curve [p3]]]
            };
        ConicTo: ImagerPath.ConicToProc ~ {
            AppendToPath[[push [p1]]];
            AppendToPath[[push [p2]]];
            AppendToPath[[conic [r]]]
            };
        ArcTo: ImagerPath.ArcToProc ~ {
            AppendToPath[[push [p1]]];
            AppendToPath[[arc [p2]]]
            };
        pathTail: Path _ path _ NIL;
        pathProc[MoveTo, LineTo, CurveTo, ConicTo, ArcTo];
        Flush[];
        };
    GetPattern: PROC [patternLen: NAT, pattern: PROC [NAT] RETURNS [REAL]] 
    RETURNS [patternRef: REF PatternSequence] ~ {
        patternRef _ NEW[PatternSequence[patternLen]];
        FOR i: NAT IN[0..patternLen) DO patternRef[i] _ pattern[i] ENDLOOP;
        };
    GetBody: PROC [context: Context, action: PROC] RETURNS [body: CommandList] ~ {
        savedData: Data ~ NARROW[context.data];
        data: Data;
        context.data _ NEW[DataRep _ [NIL, NIL]];    --Start with a fresh trail
        action[];                --Perform the action
        data _ NARROW[context.data];
        context.data _ savedData;    
        RETURN [data.head]
        };
Append: PROC[context: Context, command: CommandRep] ~ {
    WITH context.data SELECT FROM
        data: Data => {
        tail: CommandList ~ LIST[command];
        IF data.tail=NIL THEN data.head _ tail ELSE data.tail.rest _ tail;
        data.tail _ tail;
            };
        ENDCASE => ERROR;
};
    ReplayList: PROC [cList: CommandList, into: Context] ~ TRUSTED {
        FOR each: CommandList _ cList, each.rest UNTIL each=NIL DO
            <<We use this form of discrimination because it generates a jump table rather than a series of sequential tests.  Unfortunately, it 
            needs to be trusted. . .>>
            WITH cmd: each.first SELECT FROM
                DoSave => CHECKED {
                    Action: PROC ~ {
                        ReplayList[cmd.body, into];
                        };
                    IF cmd.all THEN Imager.DoSaveAll[into, Action] ELSE Imager.DoSave[into, Action];
                    };
                SetInt => ImagerBackdoor.SetInt[into, cmd.key, cmd.val];
                SetReal => ImagerBackdoor.SetReal[into, cmd.key, cmd.val];
                SetT => ImagerBackdoor.SetT[into, cmd.m];
                SetFont => Imager.SetFont[into, cmd.font];
                SetColor => Imager.SetColor[into, cmd.color];
                SetClipper => ImagerBackdoor.SetClipper[into, cmd.clipper];
                ConcatT => Imager.ConcatT[into, cmd.m];
                Scale2T => Imager.Scale2T[into, cmd.s];
                RotateT => Imager.RotateT[into, cmd.a];
                TranslateT => Imager.TranslateT[into, cmd.t];
                Move => {
                    IF cmd.rounded THEN Imager.Trans[into] ELSE Imager.Move[into];
                    };
                SetXY => Imager.SetXY[into, cmd.p];
                SetXYRel => Imager.SetXYRel[into, cmd.v];
                Show => CHECKED {
                    FeedChar: Imager.XStringProc ~ {
                        <<~ PROC [charAction: XCharProc]>>
                        <<XCharProc: TYPE ~ PROC [char: XChar];>>
                        FOR i: CARDINAL IN [0..cmd.string.n) DO
                            charAction[cmd.string[i]];
                            ENDLOOP;
                        };
                    Imager.Show[into, FeedChar, cmd.xrel];
                    };
                ShowShort => CHECKED {
                    FeedChar: Imager.XStringProc ~ {
                        <<~ PROC [charAction: XCharProc]>>
                        <<XCharProc: TYPE ~ PROC [char: XChar];>>
                        text: Rope.Text ~ cmd.text;
                        FOR i: CARDINAL IN [0..text.length) DO
                            charAction[[0, Rope.QFetch[text, i]-'\000]];
                            ENDLOOP;
                        };
                    Imager.Show[into, FeedChar, cmd.xrel];
                    };
                StartUnderline => Imager.StartUnderline[into];
                MaskUnderline => Imager.MaskUnderline[into, cmd.dy, cmd.h];
                CorrectMask => Imager.CorrectMask[into];
                CorrectSpace => Imager.CorrectSpace[into, cmd.v];
                Space => Imager.Space[into, cmd.x];
                SetCorrectMeasure => Imager.SetCorrectMeasure[into, cmd.v];
                SetCorrectTolerance => Imager.SetCorrectTolerance[into, cmd.v];
                Correct => CHECKED {
                    Action: PROC ~ {
                        ReplayList[cmd.body, into];
                        };
                    Imager.Correct[into, Action];
                    };
                DontCorrect => CHECKED {
                    Action: PROC ~ {
                        ReplayList[cmd.body, into];
                        };
                    Imager.DontCorrect[into, Action, cmd.saveCP];
                    };
                SetGray => Imager.SetGray[into, cmd.f];
                SetSampledColor => Imager.SetSampledColor[into, cmd.d.pa, cmd.d.m, cmd.d.colorOperator];
                SetSampledBlack => Imager.SetSampledBlack[into, cmd.d.pa, cmd.d.m, cmd.d.clear];
                MaskFill => CHECKED {
                    PathProc: Imager.PathProc ~ {
                        DoPath[cmd.path, moveTo, lineTo, curveTo, conicTo, arcTo];
                        };
                    Imager.MaskFill[into, PathProc, cmd.oddWrap];
                    };
                MaskRectangle => Imager.MaskRectangle[into, cmd.r^];
                MaskRectangleI => Imager.MaskRectangleI[into, cmd.x, cmd.y, cmd.w, cmd.h];
                MaskStroke => CHECKED {
                    PathProc: Imager.PathProc ~ {
                        DoPath[cmd.path, moveTo, lineTo, curveTo, conicTo, arcTo];
                        };
                    Imager.MaskStroke[into, PathProc, cmd.closed];
                    };
                MaskVector => Imager.MaskVector[into, cmd.p^[0], cmd.p^[1]];
                MaskDashedStroke => CHECKED {
                    path: Imager.PathProc ~ {
                        DoPath[cmd.d.path, moveTo, lineTo, curveTo, conicTo, arcTo];
                        };
                    pattern: PROC [i: NAT] RETURNS [REAL] ~ { RETURN[cmd.d.pattern[i]] };
                    ImagerExtras.MaskDashedStroke[context: into, path: path, 
                    patternLen: cmd.d.pattern.patternLen, pattern: pattern, 
                    offset: cmd.d.offset, length: cmd.d.length];
                    };
                MaskPixel => Imager.MaskPixel[into, cmd.pa];
                MaskBits => Imager.MaskBits[into, cmd.bits.vm.pointer, cmd.bits.wordsPerLine, cmd.bits.sMin, cmd.bits.fMin, cmd.bits.sSize, 
                cmd.bits.fSize, cmd.bits.tx, cmd.bits.ty];
                DrawBits => ImagerBackdoor.DrawBits[into, cmd.bits.vm.pointer, cmd.bits.wordsPerLine, cmd.bits.sMin, cmd.bits.fMin, cmd.bits.sSize, 
                cmd.bits.fSize, cmd.bits.tx, cmd.bits.ty];
                Clip => CHECKED {
                    PathProc: Imager.PathProc ~ {
                        DoPath[cmd.path, moveTo, lineTo, curveTo, conicTo, arcTo];
                        };
                    Imager.Clip[into, PathProc, cmd.oddWrap, cmd.exclude];
                    };
                ClipRectangle => Imager.ClipRectangle[into, cmd.r^, cmd.exclude];
                ENDCASE => ERROR;
            ENDLOOP;
        };
    ReplayListSize: PROC [cList: CommandList] RETURNS [size: INT] ~ TRUSTED {
        size _ 0;
        FOR each: CommandList _ cList, each.rest UNTIL each=NIL DO
            <<We use this form of discrimination because it generates a jump table rather than a series of sequential tests.  Unfortunately, it 
            needs to be trusted. . .>>
            WITH cmd: each.first SELECT FROM
                DoSave => CHECKED {size _ size+ReplayListSize[cmd.body];};
                SetInt => size _ size+SIZE[CommandRep[SetInt]];
                SetReal => size _ size+SIZE[CommandRep[SetReal]];
                SetT => size _ size+SIZE[CommandRep[SetT]];
                SetFont => size _ size+SIZE[CommandRep[SetFont]];
                SetColor => size _ size+SIZE[CommandRep[SetColor]];
                SetClipper => size _ size+SIZE[CommandRep[SetClipper]];
                ConcatT => size _ size+SIZE[CommandRep[ConcatT]];
                Scale2T => size _ size+SIZE[CommandRep[Scale2T]];
                RotateT => size _ size+SIZE[CommandRep[RotateT]];
                TranslateT => size _ size+SIZE[CommandRep[TranslateT]];
                Move => size _ size+SIZE[CommandRep[Move]];
                SetXY => size _ size+SIZE[CommandRep[SetXY]];
                SetXYRel => size _ size+SIZE[CommandRep[SetXYRel]];
                Show => size _ size+SIZE[XStringSeq]+1;
                ShowShort => size _ size+SIZE[Rope.Text]+1;
                StartUnderline => size _ size+SIZE[CommandRep[StartUnderline]];
                MaskUnderline => size _ size+SIZE[CommandRep[MaskUnderline]];
                CorrectMask => size _ size+SIZE[CommandRep[CorrectMask]];
                CorrectSpace => size _ size+SIZE[CommandRep[CorrectSpace]];
                Space => size _ size+SIZE[CommandRep[Space]];
                SetCorrectMeasure => size _ size+SIZE[CommandRep[SetCorrectMeasure]];
                SetCorrectTolerance => size _ size+SIZE[CommandRep[SetCorrectTolerance]];
                Correct => CHECKED {size _ size+ReplayListSize[cmd.body];};
                DontCorrect => CHECKED {size _ size+ReplayListSize[cmd.body];};
                SetGray => size _ size+SIZE[CommandRep[SetGray]];
                SetSampledColor => size _ size+SIZE[CommandRep[SetSampledColor]];
                SetSampledBlack => size _ size+SIZE[CommandRep[SetSampledBlack]];
                MaskFill => size _ size+SIZE[CommandRep[MaskFill]];
                MaskRectangle => size _ size+SIZE[CommandRep[MaskRectangle]];
                MaskRectangleI => size _ size+SIZE[CommandRep[MaskRectangleI]];
                MaskStroke => size _ size+SIZE[CommandRep[MaskStroke]];
                MaskVector => size _ size+SIZE[CommandRep[MaskVector]];
                MaskDashedStroke => size _ size+SIZE[CommandRep[MaskDashedStroke]];
                MaskPixel => size _ size+SIZE[CommandRep[MaskPixel]];
                MaskBits => size _ size+SIZE[CommandRep[MaskBits]];
                DrawBits => size _ size+SIZE[CommandRep[DrawBits]];
                Clip => size _ size+SIZE[CommandRep[Clip]];
                ClipRectangle => size _ size+SIZE[CommandRep[ClipRectangle]];
                ENDCASE => ERROR;
            ENDLOOP;
        };

<<Public Procs>>
    NewMemoryContext: PUBLIC PROC RETURNS [c: Context] ~ {
        c _ NEW[Imager.ContextRep _ [class: memoryClass, data: NEW[DataRep _ [NIL, NIL]]]];
        };

    Replay: PUBLIC PROC [c, into: Context] ~ {
        cList: CommandList ~ NARROW[c.data, Data].head;
        ReplayList[cList, into];
        };

    GetContextSize: PUBLIC PROC [c: Context] RETURNS [size: INT] ~ {
        cList: CommandList ~ NARROW[c.data, Data].head;
        RETURN[ReplayListSize[cList]];
        };
<<Memory Context Procs>>
    Bits: TYPE ~ REF BitsRep;
    BitsRep: TYPE ~ RECORD [
        wordsPerLine, sMin, fMin, sSize, fSize: NAT,
        tx, ty: INTEGER,
        vm: CountedVM.Handle
        ];
    MakeBits: PROC [base: LONG POINTER, wordsPerLine: NAT, sMin, fMin, sSize, fSize: NAT, tx, ty: INTEGER] RETURNS [bits: Bits] ~ {
        nwords: INT _ Basics.LongMult[wordsPerLine, sSize];
        vm: CountedVM.Handle _ CountedVM.SimpleAllocate[nwords];
        bits _ NEW[BitsRep _ [wordsPerLine, sMin, fMin, sSize, fSize, tx, ty, vm]];
        TRUSTED {PrincOpsUtils.LongCopy[from: base, to: vm.pointer, nwords: nwords]}
        };
    MemoryDoSave: PROC[context: Context, action: PROC, all: BOOL] ~ {
        body: CommandList ~ GetBody[context, action];
        Append[context, [DoSave [body, all]]];
        };
    MemorySetInt: PROC[context: Context, key: IntKey, val: INT] ~ {
        Append[context, [SetInt [key, val]]];
        };
    MemorySetReal: PROC[context: Context, key: RealKey, val: REAL] ~ {
        Append[context, [SetReal [key, val]]];
        };
    MemoryGetT: PROC[context: Context] RETURNS[Transformation] ~ {
        m: Transformation _ ImagerTransformation.Scale[1.0];
        data: Data ~ NARROW[context.data];
        IF NOT data.getTDone THEN {
            data.getTDone _ TRUE;
            IF (data.getTForm _ data.getTForm + 1) = endMemForm THEN data.getTForm _ firstMemForm;
            };
        m.form _ data.getTForm;
        RETURN [m];
        };
    MemorySetT: PROC[context: Context, m: Transformation] ~ {
        Append[context, [SetT [m]]];
        };
    MemorySetFont: PROC[context: Context, font: Font] ~ {
        Append[context, [SetFont [font]]];
        };
    MemorySetColor: PROC[context: Context, color: Color] ~ {
        WITH color SELECT FROM
            sampledColor: SampledColor => {
                data: Data ~ NARROW[context.data];
                IF data.getTDone AND sampledColor.um.form = data.getTForm THEN {
                    opClass: ATOM ~ ImagerColorOperator.GetColorOperatorClass[sampledColor.colorOperator];
                    um: Transformation _ ImagerTransformation.Copy[sampledColor.um];
                    um.form _ 0;
                    ImagerTransformation.ApplyPreScale[um, 1];
                    IF opClass = $SampledBlack OR opClass = $SampledBlackClear THEN
                        MemorySetSampledBlack[context, sampledColor.pa, um, opClass=$SampledBlackClear]
                    ELSE MemorySetSampledColor[context, sampledColor.pa, um, sampledColor.colorOperator];
                    RETURN;
                    };
                };
            ENDCASE => NULL;
        Append[context, [SetColor [color]]];
        };
    MemorySetClipper: PROC[context: Context, clipper: Clipper] ~ {
        Append[context, [SetClipper [clipper]]];
        };
    MemoryGetInt: PROC[context: Context, key: IntKey] RETURNS[INT] ~ {
        Imager.Error[[$unimplemented, "Not implemented"]]};
    MemoryGetReal: PROC[context: Context, key: RealKey] RETURNS[REAL] ~ {
        Imager.Error[[$unimplemented, "Not implemented"]]};
    MemoryGetFont: PROC[context: Context] RETURNS[Font] ~ {
        Imager.Error[[$unimplemented, "Not implemented"]]};
    MemoryGetColor: PROC[context: Context] RETURNS[Color] ~ {
        Imager.Error[[$unimplemented, "Not implemented"]]};
    MemoryGetClipper: PROC[context: Context] RETURNS[Clipper] ~ {
        Imager.Error[[$unimplemented, "Not implemented"]]};
    MemoryConcatT: PROC[context: Context, m: Transformation] ~ {
        Append[context, [ConcatT [m]]];
        };
    MemoryScale2T: PROC[context: Context, s: VEC] ~ {
        Append[context, [Scale2T [s]]];
        };
    MemoryRotateT: PROC[context: Context, a: REAL] ~ {
        Append[context, [RotateT [a]]];
        };
    MemoryTranslateT: PROC[context: Context, t: VEC] ~ {
        Append[context, [TranslateT [t]]];
        };
    MemoryMove: PROC[context: Context, rounded: BOOL] ~ {
        Append[context, [Move [rounded]]];
        };
    MemorySetXY: PROC[context: Context, p: VEC] ~ {
        Append[context, [SetXY [p]]];
        };
    MemorySetXYRel: PROC[context: Context, v: VEC] ~ {
        Append[context, [SetXYRel [v]]];
        };
    MemoryShow: PROC[context: Context, string: XStringProc, xrel: BOOL] ~ {
        eightbit: BOOL _ TRUE;
        n: INT _ 0;
        CountXChars: ImagerFont.XCharProc ~ {
            IF char.set # 0 THEN eightbit _ FALSE;
            n _ n+1;
            };
        InstallXChar: ImagerFont.XCharProc ~ {
            xString[n] _ char;
            n _ n+1;
            };
        xString: XStringSeq;
        string[CountXChars];        -- Count number of chars fed back, set eightbit
        IF eightbit THEN {
            text: Rope.Text ~ Rope.NewText[n];
            i: NAT _ 0;
            InstallChar: ImagerFont.XCharProc ~ {
                text[i] _ VAL[char.code];
                i _ i+1;
                };
            text.length _ n;
            string[InstallChar];        -- Install each character
            Append[context, [ShowShort [text: text, xrel: xrel]]];
            }
        ELSE {
            xString: XStringSeq ~ NEW[XStringSeqRec[n]];
            i: INT _ 0;
            InstallXChar: ImagerFont.XCharProc ~ {
                xString[i] _ char;
                i _ i+1;
                };
            string[InstallXChar];        -- Install each character
            Append[context, [Show [string: xString, xrel: xrel]]];
            };
        };
    MemoryShowText: PROC[context: Context, text: REF READONLY TEXT, start, len: NAT, xrel: BOOL] ~ {
        class: Class ~ context.class;
        string: XStringProc ~ { ImagerFont.MapText[text, start, len, charAction] };
        class.Show[context, string, xrel];
        };
    MemoryStartUnderline: PROC[context: Context] ~ {
        Append[context, [StartUnderline []]]};
    MemoryMaskUnderline: PROC[context: Context, dy, h: REAL] ~ {
        Append[context, [MaskUnderline [dy, h]]];
        };
    MemoryCorrectMask: PROC[context: Context] ~ {
        Append[context, [CorrectMask []]]};
    MemoryCorrectSpace: PROC[context: Context, v: VEC] ~ {
        Append[context, [CorrectSpace [v]]];
        };
    MemorySpace: PROC[context: Context, x: REAL] ~ {
        Append[context, [Space [x]]];
        };
    MemorySetCorrectMeasure: PROC[context: Context, v: VEC] ~ {
        Append[context, [SetCorrectMeasure [v]]];
        };
    MemorySetCorrectTolerance: PROC[context: Context, v: VEC] ~ {
        Append[context, [SetCorrectTolerance [v]]];
        };
    MemoryCorrect: PROC[context: Context, action: PROC] ~ {
        body: CommandList ~ GetBody[context, action];
        Append[context, [Correct [body]]];
        };
    MemoryDontCorrect: PROC[context: Context, action: PROC, saveCP: BOOL] ~ {
        body: CommandList ~ GetBody[context, action];
        Append[context, [DontCorrect [body, saveCP]]];
        };
    MemorySetGray: PROC[context: Context, f: REAL] ~ {
        Append[context, [SetGray [f]]];
        };
    MemorySetSampledColor: PROC[context: Context, pa: PixelArray, m: Transformation, colorOperator: ColorOperator] ~ {
        Append[context, [SetSampledColor [NEW[SetSampledColorData _ [pa, m, colorOperator]]]]];
        };
    MemorySetSampledBlack: PROC[context: Context, pa: PixelArray, m: Transformation, clear: BOOL] ~ {
        Append[context, [SetSampledBlack [NEW[SetSampledBlackData _ [pa, m, clear]]]]];
        };
    MemoryMaskFill: PROC[context: Context, path: PathProc, oddWrap: BOOL] ~ {
        pathList: Path ~ GetPath[path];
        Append[context, [MaskFill [pathList, oddWrap]]];
        };
    MemoryMaskRectangle: PROC[context: Context, r: Rectangle] ~ {
        Append[context, [MaskRectangle [NEW[Rectangle _ r]]]];
        };
    MemoryMaskRectangleI: PROC[context: Context, x, y, w, h: INTEGER] ~ {
        Append[context, [MaskRectangleI [x, y, w, h]]];
        };
    MemoryMaskStroke: PROC[context: Context, path: PathProc, closed: BOOL] ~ {
        pathList: Path ~ GetPath[path];
        Append[context, [MaskStroke [pathList, closed]]];
        };
    MemoryMaskVector: PROC[context: Context, p1, p2: VEC] ~ {
        Append[context, [MaskVector [NEW[ARRAY [0..2) OF VEC _ [p1, p2]]]]];
        };
    MemoryMaskDashedStroke: PROC[context: Context, path: PathProc, 
    patternLen: NAT, pattern: PROC [NAT] RETURNS [REAL], offset, length: REAL] ~ {
        pathRef: Path ~ GetPath[path];
        patternRef: REF PatternSequence ~ GetPattern[patternLen, pattern];
        Append[context, [MaskDashedStroke [NEW[MaskDashedStrokeData _ [
        path: pathRef, pattern: patternRef, offset: offset, length: length]]]]];
        };
    MemoryMaskPixel: PROC[context: Context, pa: PixelArray] ~ {
        Append[context, [MaskPixel [pa]]];
        };
    MemoryMaskBits: PROC[context: Context, base: LONG POINTER, wordsPerLine: NAT, sMin, fMin, sSize, fSize: NAT, tx, ty: INTEGER] ~ {
        bits: Bits ~ MakeBits[base, wordsPerLine, sMin, fMin, sSize, fSize, tx, ty];
        Append[context, [MaskBits [bits]]];
        };
    MemoryDrawBits: PROC[context: Context, base: LONG POINTER, wordsPerLine: NAT, sMin, fMin, sSize, fSize: NAT, tx, ty: INTEGER] ~ {
        bits: Bits ~ MakeBits[base, wordsPerLine, sMin, fMin, sSize, fSize, tx, ty];
        Append[context, [DrawBits [bits]]];
        };
    MemoryClip: PROC[context: Context, path: PathProc, oddWrap: BOOL, exclude: BOOL] ~ {
        pathList: Path ~ GetPath[path];
        Append[context, [Clip [pathList, oddWrap, exclude]]];
        };
    MemoryClipRectangle: PROC[context: Context, r: Rectangle, exclude: BOOL] ~ {
        Append[context, [ClipRectangle [NEW[Rectangle _ r], exclude]]];
        };
    MemoryClipRectangleI: PROC[context: Context, x, y, w, h: INTEGER, exclude: BOOL] ~ {
        Append[context, [ClipRectangle [NEW[Rectangle _ [x, y, w, h]], exclude]]];
        };
    MemoryGetCP: PROC[context: Context, rounded: BOOL] RETURNS[VEC] ~ {
        Imager.Error[[$unimplemented, "Not implemented"]]};
    MemoryGetBoundingRectangle: PROC[context: Context] RETURNS[Rectangle] ~ {
        Imager.Error[[$unimplemented, "Not implemented"]]};

memoryClass: Class ~ NEW[ClassRep _ [
    type: $Memory,
    DoSave: MemoryDoSave,
    SetInt: MemorySetInt,
    SetReal: MemorySetReal,
    SetT: MemorySetT,
    SetFont: MemorySetFont,
    SetColor: MemorySetColor,
    SetClipper: MemorySetClipper,
    GetInt: MemoryGetInt,
    GetReal: MemoryGetReal,
    GetT: MemoryGetT,
    GetFont: MemoryGetFont,
    GetColor: MemoryGetColor,
    GetClipper: MemoryGetClipper,
    ConcatT: MemoryConcatT,
    Scale2T: MemoryScale2T,
    RotateT: MemoryRotateT,
    TranslateT: MemoryTranslateT,
    Move: MemoryMove,
    SetXY: MemorySetXY,
    SetXYRel: MemorySetXYRel,
    Show: MemoryShow,
    ShowText: MemoryShowText,
    StartUnderline: MemoryStartUnderline,
    MaskUnderline: MemoryMaskUnderline,
    CorrectMask: MemoryCorrectMask,
    CorrectSpace: MemoryCorrectSpace,
    Space: MemorySpace,
    SetCorrectMeasure: MemorySetCorrectMeasure,
    SetCorrectTolerance: MemorySetCorrectTolerance,
    Correct: MemoryCorrect,
    DontCorrect: MemoryDontCorrect,
    SetGray: MemorySetGray,
    SetSampledColor: MemorySetSampledColor,
    SetSampledBlack: MemorySetSampledBlack,
    MaskFill: MemoryMaskFill,
    MaskRectangle: MemoryMaskRectangle,
    MaskRectangleI: MemoryMaskRectangleI,
    MaskStroke: MemoryMaskStroke,
    MaskVector: MemoryMaskVector,
    MaskDashedStroke: MemoryMaskDashedStroke,
    MaskPixel: MemoryMaskPixel,
    MaskBits: MemoryMaskBits,
    DrawBits: MemoryDrawBits,
    Clip: MemoryClip,
    ClipRectangle: MemoryClipRectangle,
    ClipRectangleI: MemoryClipRectangleI,
    GetCP: MemoryGetCP,
    GetBoundingRectangle: MemoryGetBoundingRectangle
]];

END.