<<>>
<<SampledCurveEditImpl.mesa>>
<<Copyright Ó 1983, 1992 Xerox Corporation.  All rights reserved.>>
<<Michael Plass, June 30, 1992 4:47 pm PDT>>
    DIRECTORY
        Atom,
        BiScrollers,
        Commander,
        Complex,
        Convert,
        Geom2D,
        SampledCurveEdit,
        InputFocus,
        FS,
        Imager,
        ImagerPath,
        ImagerBackdoor,
        IO,
        Menus,
        MessageWindow,
        Process,
        Real,
        Rope,
        RuntimeError,
        TIPUser,
        Vector2,
        ViewerClasses,
        ViewerOps,
        ViewerTools
        ;

    SampledCurveEditImpl: CEDAR MONITOR
        IMPORTS Atom, BiScrollers, Commander, Complex, Convert, Geom2D, InputFocus, FS, Imager, ImagerBackdoor, IO, Menus, MessageWindow, 
        Process, Real, Rope, RuntimeError, TIPUser, ViewerOps, ViewerTools
        EXPORTS SampledCurveEdit
    ~ BEGIN OPEN SampledCurveEdit;

    header: MarkedPoint ~ [2, 2, TRUE, open];
    ROPE: TYPE ~ Rope.ROPE;
    VEC: TYPE ~ Vector2.VEC;
    COMPLEX: TYPE ~ Complex.VEC;

    Tool: TYPE = REF ToolRec;
    ToolRec: TYPE = RECORD [
        actionQueue: LIST OF REF,
        lockProcess: UNSAFE PROCESS Ź NIL,
        lockCount: CARDINAL Ź 0,
        lockFree: CONDITION,
        outline: LIST OF Trajectory,
        <<The first trajectory in the outline is the one currently being edited.>>
        grabbed: LIST OF MarkedPoint,
        <<Points to the item before the point or points actually grabbed.>>
        grabbedCount: NAT,
        selected: LIST OF MarkedPoint Ź NIL,
        <<Points to the item before the point actually selected.>>
        selectedCount: NAT Ź 0,
        undoList: LIST OF MarkedPoint Ź NIL,
        dragSource: MarkedPoint Ź header,
        moveSource: MarkedPoint Ź header,
        paintRectangles: LIST OF PaintRectangle
        ];

    CheckConsistency: PROC [tool: Tool] ~ {
        grabbedAppeared, selectedAppeared: BOOL Ź FALSE;
        grabbedLeftover, selectedLeftover: INT Ź 0;
        end: LIST OF MarkedPoint Ź NIL;
        IF tool.outline # NIL THEN {
            stopper: NAT Ź NAT.LAST;
            FOR p: LIST OF MarkedPoint Ź tool.outline.first, p.rest UNTIL p = NIL DO
                IF p = tool.selected THEN {
                    IF selectedAppeared THEN ERROR;
                    selectedAppeared Ź TRUE;
                    selectedLeftover Ź tool.selectedCount + 1;
                    };
                IF p = tool.grabbed THEN {
                    IF grabbedAppeared THEN ERROR;
                    grabbedAppeared Ź TRUE;
                    grabbedLeftover Ź tool.grabbedCount + 1;
                    };
                selectedLeftover Ź MAX[selectedLeftover - 1, 0];
                grabbedLeftover Ź MAX[grabbedLeftover - 1, 0];
                stopper Ź stopper - 1;
                end Ź p;
                ENDLOOP;
            IF tool.outline.first.first.kind # open THEN {
                IF tool.outline.first.first.x # end.first.x THEN ERROR;
                IF tool.outline.first.first.y # end.first.y THEN ERROR;
                };
            }; 
        IF tool.selected # NIL AND NOT selectedAppeared THEN ERROR;
        IF tool.grabbed # NIL AND NOT grabbedAppeared THEN ERROR;
        IF selectedLeftover # 0 THEN ERROR;
        IF grabbedLeftover # 0 THEN ERROR;
        };

    PaintRectangle: TYPE ~ RECORD [
        xMin, yMin, xMax, yMax: REAL
        ];

    NewData: PROC RETURNS [REF] ~ {
        tool: Tool Ź NEW[ToolRec];
        tool.outline Ź LIST[LIST[header]];
        tool.grabbed Ź NIL;
        tool.grabbedCount Ź 0;
        RETURN [tool];
        };

    InitViewer: PROC [self: Viewer] = {
        IF self.file # NIL THEN {
            LoadFile[self];
            };
        };

    LoadFile: PROC [self: Viewer] = {
        Err: PROC [msg: ROPE, pos: INT Ź -1] ~ {
            MessageWindow.Append[msg, TRUE];
            IF pos>=0 THEN MessageWindow.Append[Convert.RopeFromInt[pos], FALSE];
            MessageWindow.Blink[];
            };
        stream: IO.STREAM Ź FS.StreamOpen[self.file, $read ! FS.Error => {MessageWindow.Append[error.explanation, TRUE]; 
        MessageWindow.Blink[]; GOTO Quit}];
        outline: Outline Ź NIL;
        stack: ARRAY [0..10) OF REAL;
        stackTop: INT Ź 0;
        kind: PointKind Ź sample;
        PushReal: PROC [real: REAL] ~ {
            IF stackTop >= 10 THEN {Err["SampledCurveEdit stack overflow at ", stream.GetIndex]; RETURN};
            stack[stackTop] Ź real;
            stackTop Ź stackTop + 1;
            };
        PopReal: PROC RETURNS [real: REAL] ~ {
            IF stackTop <= 0 THEN {Err["SampledCurveEdit stack underflow at ", stream.GetIndex]; RETURN [0]};
            stackTop Ź stackTop - 1;
            real Ź stack[stackTop];
            };
        curTrajEnd: Trajectory Ź NIL;
        DO
            r: REF ANY Ź NIL;
            r Ź IO.GetRefAny[stream ! IO.EndOfStream => CONTINUE];
            IF r = NIL THEN EXIT;
            WITH r SELECT FROM
                refInt: REF INT => PushReal[refInt­];
                refCard: REF LONG CARDINAL => PushReal[refCard­];
                refReal: REF REAL => PushReal[refReal­];
                atom: ATOM => {
                    SELECT atom FROM
                        $MOVETO => {
                            y: REAL Ź PopReal[];
                            x: REAL Ź PopReal[];
                            outline Ź CONS[LIST[[x: 0, y: 0, isHeader: TRUE, kind: open], [x: x, y: y, isHeader: FALSE, kind: sample]], outline];
                            curTrajEnd Ź outline.first.rest;
                            kind Ź sample;
                            };
                        $LINETO => {
                            y: REAL Ź PopReal[];
                            x: REAL Ź PopReal[];
                            IF curTrajEnd = NIL THEN {Err["SampledCurveEdit Missing MOVETO", stream.GetIndex]; EXIT};
                            curTrajEnd.rest Ź LIST[[x: x, y: y, isHeader: FALSE, kind: kind]];
                            curTrajEnd Ź curTrajEnd.rest;
                            kind Ź sample;
                            };
                        $CORNER => {
                            kind Ź corner;
                            };
                        $KNOT => {
                            kind Ź knot;
                            };
                        $CLOSE => {
                            y: REAL Ź curTrajEnd.first.y;
                            x: REAL Ź curTrajEnd.first.x;
                            outline.first.first.x Ź x;
                            outline.first.first.y Ź y;
                            outline.first.first.kind Ź sample;
                            curTrajEnd Ź NIL;
                            };
                        ENDCASE => {Err["SampledCurveEdit parse error at position ", stream.GetIndex]; EXIT};
                    };
                ENDCASE => {Err["SampledCurveEdit parse error at position ", stream.GetIndex]; EXIT};
            ENDLOOP;
        IF stackTop # 0 THEN Err["SampledCurveEdit stack not empty at exit"];
        outline Ź ReverseOutline[outline];
        SetOutline[self, outline];
        IO.Close[stream];
        EXITS Quit => NULL;
        };

    ReverseOutline: PROC [outline: LIST OF Trajectory] RETURNS [reversed: LIST OF Trajectory Ź NIL] ~ {
        WHILE outline # NIL DO
            t: LIST OF Trajectory Ź outline;
            outline Ź outline.rest;
            t.rest Ź reversed;
            reversed Ź t;
            ENDLOOP;
        };

    DoWithLock: PROC [viewer: Viewer, inner: PROC [tool: Tool]] ~ {
        DoWithLockedData[BiScrollers.ClientDataOfViewer[viewer], inner];
        };

    DoWithLockedData: PROC [data: REF, inner: PROC [tool: Tool]] ~ {
        WITH data SELECT FROM
            tool: Tool => {
                Lock: ENTRY PROC ~ {
                    UNTIL tool.lockProcess = NIL OR tool.lockProcess = Process.GetCurrent[] DO WAIT tool.lockFree ENDLOOP;
                    tool.lockProcess Ź Process.GetCurrent[];
                    tool.lockCount Ź tool.lockCount + 1;
                    };
                UnLock: ENTRY PROC ~ {
                    IF (tool.lockCount Ź tool.lockCount - 1) = 0 THEN {
                        tool.lockProcess Ź NIL;
                        NOTIFY tool.lockFree;
                        };
                    };
                Lock[];
                inner[tool ! UNWIND => UnLock[]];
                UnLock[];
                };
            ENDCASE => NULL;
        };

    keep: NAT Ź 2;
    SaveProc: PROC [self: Viewer, force: BOOL Ź FALSE] = {
        Locked: PROC [tool: Tool] ~ {
            stream: IO.STREAM Ź FS.StreamOpen[fileName: self.file, accessOptions: $create, keep: keep ! FS.Error => 
            {MessageWindow.Append[error.explanation, TRUE]; MessageWindow.Blink[]; GOTO Quit}];
            PutPoint: PROC [pt: MarkedPoint] ~ {
                stream.PutF["%g %g ", IO.real[pt.x], IO.real[pt.y]];
                SELECT pt.kind FROM
                    corner => stream.PutRope["CORNER "];
                    knot => stream.PutRope["KNOT "];
                    ENDCASE => NULL;
                };
            outline: Outline Ź NIL;
            WITH BiScrollers.ClientDataOfViewer[self] SELECT FROM
                tool: Tool => {outline Ź tool.outline};
                ENDCASE => NULL;
            WHILE outline # NIL DO
                traj: Trajectory Ź outline.first;
                IF traj.rest # NIL THEN {
                    stream.PutRope["  \n"];
                    PutPoint[traj.rest.first]; stream.PutRope["MOVETO\n"];
                    FOR p: PointList Ź traj.rest.rest, p.rest UNTIL p=NIL DO
                        stream.PutRope["  "]; PutPoint[p.first]; stream.PutRope["LINETO\n"];
                        ENDLOOP;
                    IF traj.first.kind # open THEN {
                        stream.PutRope["  CLOSE\n"];
                        };
                    };
                outline Ź outline.rest;
                ENDLOOP;
            self.name Ź Rope.Concat["Sampled Curve Editor ", self.file];
            self.label Ź self.file;
            stream.Close;
            EXITS Quit => NULL;
            };
        IF self.file # NIL THEN DoWithLock[self, Locked];
        };

    PaintPoint: PROCEDURE [context: Imager.Context, pt: MarkedPoint] = {
        x: REAL ~ pt.x;
        y: REAL ~ pt.y;
        SELECT pt.kind FROM
            corner => {
                Imager.SetColor[context, Imager.black];
                Imager.MaskBox[context, [x-2, y-3, x+2, y+3]];
                Imager.MaskBox[context, [x-3, y-2, x+3, y+2]];
                Imager.SetColor[context, Imager.white];
                Imager.MaskBox[context, [x-1, y-2, x+1, y+2]];
                Imager.MaskBox[context, [x-2, y-1, x+2, y+1]];
                };
            sample, knot => {
                Imager.SetColor[context, Imager.black];
                Imager.MaskBox[context, [x-2, y-2, x+2, y+2]];
                Imager.SetColor[context, Imager.white];
                Imager.MaskBox[context, [x-1, y-1, x+1, y+1]];
                };
            ENDCASE => NULL;
        };

    FetchPt: PROC [l: LIST OF MarkedPoint, i: INT] RETURNS [MarkedPoint] ~ {
        WHILE i > 0 DO l Ź l.rest; i Ź i-1 ENDLOOP;
        RETURN [l.first]
        };

    BreakCurrentTrajectory: PROCEDURE [tool: Tool] = {
    <<Breaks the trajectory before the current selection; turns a closed loop into an open trajectory, or an open trajectory into two 
    trajectories.>>
        IF tool.selected # NIL AND NOT tool.selected.first.isHeader THEN {
            IF tool.outline.first.first.kind = open THEN {
                new: LIST OF MarkedPoint Ź CONS[tool.outline.first.first, tool.selected.rest];
                tool.selected.rest Ź NIL;
                tool.selected Ź new;
                tool.outline Ź CONS[new, tool.outline];
                }
            ELSE {
                new: LIST OF MarkedPoint Ź tool.outline.first;
                newTail: LIST OF MarkedPoint Ź new.rest;
                p: LIST OF MarkedPoint Ź tool.selected.rest;
                new.rest Ź p;
                tool.selected.rest Ź NIL;
                UNTIL p.rest = NIL DO p Ź p.rest ENDLOOP;
                p.rest Ź newTail;
                new.first.x Ź 0;
                new.first.y Ź 0;
                new.first.kind Ź open;
                tool.selected Ź new;
                };
            };
        };

    DrawOutline: PROCEDURE [tool: Tool, context: Imager.Context] = {
        Path: ImagerPath.PathProc ~ {
            FOR t: LIST OF Trajectory Ź tool.outline, t.rest UNTIL t=NIL DO
                IF t.first.rest # NIL THEN {
                    start: MarkedPoint Ź t.first.first;
                    IF start.kind = open THEN start Ź t.first.rest.first;
                    moveTo[[start.x, start.y]];
                    FOR p: LIST OF MarkedPoint Ź t.first.rest.rest, p.rest UNTIL p=NIL DO
                        lineTo[[p.first.x, p.first.y]];
                        ENDLOOP;
                    };
                ENDLOOP;
            };
        Imager.SetColor[context, Imager.black];
        Imager.SetStrokeWidth[context, 0];
        Imager.SetStrokeEnd[context, $round];
        Imager.SetStrokeJoint[context, $round];
        Imager.MaskStroke[context: context, path: Path, closed: FALSE];
        IF tool.outline # NIL THEN {
            FOR p: LIST OF MarkedPoint Ź tool.outline.first.rest, p.rest UNTIL p=NIL DO
                PaintPoint[context, p.first];
                ENDLOOP;
            };
        };

    InvertSelection: PROCEDURE [viewer: Viewer, context: Imager.Context] = {
        tool: Tool Ź NARROW[BiScrollers.ClientDataOfViewer[viewer]];
        [] Ź Imager.SetColor[context, ImagerBackdoor.invert];
        IF tool.selected # NIL THEN {
            list: LIST OF MarkedPoint Ź tool.selected.rest;
            FOR i: NAT IN [0..tool.selectedCount) DO
                p: MarkedPoint Ź list.first;
                Imager.MaskBox[context, [p.x-4, p.y-4, p.x+4, p.y+4]];
                list Ź list.rest;
                IF list = NIL THEN list Ź tool.outline.first.rest;
                ENDLOOP;
            };
        };

    MagSqr: PROCEDURE [x, y: REAL] RETURNS [REAL] = {RETURN[x*x+y*y]};

    SelectNewTrajectory: PROCEDURE [tool: Tool, v: MarkedPoint] RETURNS [changed: BOOLEAN] ~ {
        d: REAL Ź 99999999;
        last: LIST OF Trajectory Ź NIL;
        new: LIST OF Trajectory Ź NIL;
        IF tool.outline = NIL THEN RETURN [FALSE];
        FOR t: LIST OF Trajectory Ź tool.outline, t.rest UNTIL t=NIL DO
            FOR p: LIST OF MarkedPoint Ź t.first, p.rest UNTIL p.rest=NIL DO
                markedPoint: MarkedPoint Ź p.rest.first;
                s: REAL Ź MagSqr[markedPoint.x-v.x, markedPoint.y-v.y];
                IF s < d THEN {new Ź t; d Ź s};
                ENDLOOP;
            last Ź t;
            ENDLOOP;
        IF new = tool.outline THEN RETURN [FALSE];
        last.rest Ź tool.outline;
        DO
            IF tool.outline.rest = new THEN {tool.outline.rest Ź NIL; tool.outline Ź new; RETURN [TRUE]};
            tool.outline Ź tool.outline.rest;
            ENDLOOP;
        };

    GrabPoint: PROCEDURE [tool: Tool, v: MarkedPoint] = {
        d: REAL Ź 99999999;
        tool.grabbed Ź NIL;
        tool.grabbedCount Ź 0;
        IF tool.outline # NIL THEN {
            FOR p: LIST OF MarkedPoint Ź tool.outline.first, p.rest UNTIL p.rest=NIL DO
                markedPoint: MarkedPoint Ź p.rest.first;
                s: REAL Ź MagSqr[markedPoint.x-v.x, markedPoint.y-v.y];
                IF s < d THEN {tool.grabbed Ź p; tool.grabbedCount Ź 1; d Ź s};
                ENDLOOP;
            };
        };

    metersPerPixel: REAL ~ 3.527777e-4;
    pixelsPerMeter: REAL ~ 1.0/metersPerPixel;

    PaintProc: ViewerClasses.PaintProc
    <<PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL]>>
        = {
        tool: Tool Ź NARROW[BiScrollers.ClientDataOfViewer[self]];
        SELECT whatChanged FROM
            NIL => Notify[self, LIST[$Refresh]];
            $PaintAll => {
                Imager.SetColor[context, Imager.white];
                Imager.MaskRectangle[context, ImagerBackdoor.GetBounds[context]];
                DrawOutline[tool, context];
                InvertSelection[self, context];
                };
            $TouchUp => {
                Imager.SetColor[context, Imager.white];
                FOR paintList: LIST OF PaintRectangle Ź tool.paintRectangles, paintList.rest UNTIL paintList = NIL DO
                    box: PaintRectangle ~ paintList.first;
                    Imager.MaskBox[context, [box.xMin, box.yMin, box.xMax, box.yMax]];
                    ENDLOOP;
                Imager.SetColor[context, Imager.black];
                FOR paintList: LIST OF PaintRectangle Ź tool.paintRectangles, paintList.rest UNTIL paintList = NIL DO
                    box: PaintRectangle ~ paintList.first;
                    Proc: PROC ~ {
                        Imager.ClipRectangle[context, [box.xMin, box.yMin, box.xMax-box.xMin, box.yMax-box.yMin]];
                        DrawOutline[tool, context];
                        InvertSelection[self, context];
                        };
                    Imager.DoSaveAll[context, Proc];
                    ENDLOOP;
                };
            $NewPt => {
                p: MarkedPoint Ź tool.outline.first.rest.first;
                Imager.SetColor[context, Imager.black];
                IF tool.outline.first.rest.rest # NIL THEN {
                    q: MarkedPoint Ź tool.outline.first.rest.rest.first;
                    Imager.SetStrokeWidth[context, 0];
                    Imager.MaskVector[context, [q.x, q.y], [p.x, p.y]];
                    PaintPoint[context, q];
                    };
                PaintPoint[context, p];
                };
            $InvertGrabbed => IF tool.grabbed # NIL THEN {
                prevKind: PointKind Ź open;
                list: LIST OF MarkedPoint;
                Imager.SetColor[context, ImagerBackdoor.invert];
                list Ź tool.grabbed.rest;
                FOR i: NAT IN [0..tool.grabbedCount) WHILE list # NIL DO
                    p: MarkedPoint Ź list.first;
                    Imager.MaskBox[context, [p.x-2, p.y-2, p.x+2, p.y+2]];
                    list Ź list.rest;
                    ENDLOOP;
                {
                    Path: ImagerPath.PathProc ~ {
                        moveTo[[tool.grabbed.first.x, tool.grabbed.first.y]];
                        prevKind Ź tool.grabbed.first.kind;
                        list Ź tool.grabbed.rest;
                        FOR i: NAT IN [0..tool.grabbedCount+1) DO
                            p: MarkedPoint Ź list.first;
                            IF prevKind = open OR p.kind = open
                            THEN moveTo[[p.x, p.y]]
                            ELSE lineTo[[p.x, p.y]];
                            prevKind Ź p.kind;
                            list Ź list.rest;
                            IF list = NIL THEN list Ź tool.outline.first.rest;
                            ENDLOOP;
                        };
                    Imager.SetStrokeWidth[context, 0];
                    Imager.MaskStroke[context, Path];
                    };
                };
            $EraseGrabbedPoint => IF tool.grabbed # NIL THEN {
                list: LIST OF MarkedPoint Ź tool.grabbed.rest;
                Imager.SetColor[context, Imager.white];
                FOR i: NAT IN [0..tool.grabbedCount) WHILE list # NIL DO
                    p: MarkedPoint Ź list.first;
                    Imager.MaskBox[context, [p.x-2, p.y-2, p.x+2, p.y+2]];
                    list Ź list.rest;
                    ENDLOOP;
                };
            $InvertSel => InvertSelection[self, context];
            ENDCASE => ERROR;
        };    

    ActionWithPoint: TYPE = REF ActionWithPointRep;
    ActionWithPointRep: TYPE = RECORD [
        atom: ATOM,
        markedPoint: MarkedPoint
        ];

    MalformedTrajectory: PUBLIC ERROR ~ CODE;
    CopyTrajectory: PUBLIC PROC [trajectory: Trajectory] RETURNS [Trajectory] ~ {
        IF trajectory = NIL THEN ERROR MalformedTrajectory
        ELSE {
            new: Trajectory ~ LIST[trajectory.first];
            end: Trajectory Ź new;
            markedPoint: MarkedPoint Ź trajectory.first;
            IF NOT new.first.isHeader THEN ERROR MalformedTrajectory;
            WHILE (trajectory Ź trajectory.rest) # NIL DO
                markedPoint Ź trajectory.first;
                IF markedPoint.isHeader THEN ERROR MalformedTrajectory;
                end.rest Ź LIST[markedPoint];
                end Ź end.rest;
                ENDLOOP;
            IF new.first.kind # open THEN {
                headPoint: MarkedPoint Ź new.first;
                headPoint.isHeader Ź markedPoint.isHeader;
                IF headPoint # markedPoint THEN ERROR MalformedTrajectory;
                };
            RETURN [new];
            };
        };

    TrajectoryFromPoints: PROC [list: LIST OF MarkedPoint, count: INT] RETURNS [Trajectory] ~ {
        new: Trajectory ~ LIST[header];
        end: Trajectory Ź new;
        FOR i: INT IN [0..count) WHILE list # NIL DO
            markedPoint: MarkedPoint Ź list.first;
            end.rest Ź LIST[markedPoint];
            end Ź end.rest;
            list Ź list.rest;
            ENDLOOP;
        RETURN [new];
        };

    CopyOutline: PUBLIC PROC [outline: Outline] RETURNS [Outline] ~ {
        new: Outline ~ LIST[NIL];
        end: Outline Ź new;
        WHILE outline # NIL DO
            traj: Trajectory Ź CopyTrajectory[outline.first];
            end.rest Ź LIST[traj];
            end Ź end.rest;
            outline Ź outline.rest;
            ENDLOOP;
        RETURN [new.rest];
        };

    GetOutline: PUBLIC PROC [viewer: Viewer] RETURNS [outline: Outline Ź NIL] ~ {
        Locked: PROC [tool: Tool] ~ {outline Ź CopyOutline[tool.outline]};
        DoWithLock[viewer, Locked];
        };

    ObtainOutline: PUBLIC PROC [viewer: Viewer] RETURNS [outline: Outline] ~ {
        Locked: PROC [tool: Tool] ~ {
            outline Ź tool.outline;
            outline Ź tool.outline;
            tool.outline Ź NIL;
            tool.grabbed Ź tool.selected Ź NIL;
            tool.grabbedCount Ź tool.selectedCount Ź 0;
            tool.actionQueue Ź LIST[NIL, $PaintAll];
            TRUSTED {Process.Detach[FORK DispatchProcess[viewer]]};
            };
        DoWithLock[viewer, Locked];
        };

    SetOutline: PUBLIC PROC [viewer: Viewer, outline: Outline] ~ {
        viewer.class.notify[viewer, LIST[outline]];
        };

    Notify: ENTRY ViewerClasses.NotifyProc = {
        ENABLE {UNWIND => NULL; RuntimeError.UNCAUGHT => {MessageWindow.Append["SampledCurveEdit UNCAUGHT ERROR in Notify", TRUE]; 
        MessageWindow.Blink[]; GOTO Quit}};
        tool: Tool Ź NARROW[BiScrollers.ClientDataOfViewer[self]];
        viewer: Viewer ~ self;
        Unknown: PROC ~ {
            stream: IO.STREAM Ź IO.ROS[];
            stream.PutRope["Unknown input: "];
            stream.Put1[IO.refAny[input]];
            MessageWindow.Append[IO.RopeFromROS[stream], TRUE];
            stream.Close[];
            };
        ActionKind: TYPE ~ {Ordinary, AutoInverse, Idempotent};
        Queue: PROC [action: REF, kind: ActionKind Ź $Ordinary, markedPoint: MarkedPoint Ź header] ~ {
            LastAction: PROC RETURNS [REF] ~ {
                RETURN [WITH ultimate.first SELECT FROM
                    actionWithPoint: ActionWithPoint => actionWithPoint.atom,
                    ENDCASE => ultimate.first
                    ]
                };
            penultimate: LIST OF REF Ź NIL;
            ultimate: LIST OF REF Ź tool.actionQueue;
            IF ultimate = NIL THEN TRUSTED {
                ultimate Ź tool.actionQueue Ź LIST[NIL];
                <<List head is present iff DispatchProcess is alive.>>
                Process.Detach[FORK DispatchProcess[viewer]];
                };
            FOR q: LIST OF REF Ź tool.actionQueue, q.rest UNTIL q = NIL DO
                penultimate Ź ultimate;
                ultimate Ź q;
                ENDLOOP;
            SELECT kind FROM
                $Ordinary => NULL;
                $AutoInverse => IF LastAction[] = action THEN {penultimate.rest Ź NIL; RETURN};
                $Idempotent => IF LastAction[] = action THEN {
                    WITH ultimate.first SELECT FROM
                        actionWithPoint: ActionWithPoint => actionWithPoint.markedPoint Ź markedPoint;
                        ENDCASE => NULL;
                    RETURN
                    };
                ENDCASE => ERROR;
            ultimate.rest Ź LIST[
                IF markedPoint = header THEN action
                ELSE NEW[ActionWithPointRep Ź [NARROW[action], markedPoint]]
                ];
            };
        QueuePaintAll: PROC ~ {
            q: LIST OF REF Ź tool.actionQueue;
            IF q # NIL THEN {
                WHILE q.rest#NIL DO
                    SELECT q.rest.first FROM
                        $InvertSel, $InvertGrabbed, $TouchUp, $EraseGrabbedPoint, $PaintAll => q.rest Ź q.rest.rest;
                        ENDCASE => q Ź q.rest;
                    ENDLOOP;
                };
            Queue[$PaintAll];
            };
        QueueTouchUp: PROC ~ {
            q: LIST OF REF Ź tool.actionQueue;
            deferred: LIST OF REF Ź NIL;
            IF q # NIL THEN {
                WHILE q.rest#NIL DO
                    SELECT q.rest.first FROM
                        $TouchUp => {
                            deferred Ź q.rest;
                            q.rest Ź q.rest.rest;
                            deferred.rest Ź NIL;
                            };
                        $InvertGrabbed, $EraseGrabbedPoint => {
                            IF deferred # NIL THEN {
                                deferred.rest Ź q.rest;
                                q.rest Ź deferred;
                                deferred Ź NIL;
                                q Ź q.rest;
                                };
                            q Ź q.rest;
                            };
                        ENDCASE => q Ź q.rest;
                    ENDLOOP;
                IF deferred # NIL THEN {q.rest Ź deferred; RETURN};
                };
            Queue[$TouchUp];
            };
        WITH input.first SELECT FROM
            atom: ATOM => {
                SELECT atom FROM
                    $Clear => {Queue[$Clear]; QueuePaintAll[]};
                    $Delete => {
                        Queue[$DeleteSelected];
                        <<Records touchup box>>
                        QueueTouchUp[];
                        };
                    $Copy => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$Copy];
                        Queue[$InvertSel, $AutoInverse];
                        };
                    $Refresh => QueuePaintAll[];
                    $Reverse => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$ClearSel, $Idempotent];
                        Queue[$ReverseTrajectory, $AutoInverse];
                        };
                    $Save => {
                        Queue[$Save, $Idempotent];
                        };
                    $Store => {
                        selection: ROPE Ź ViewerTools.GetSelectionContents[];
                        wd: ROPE Ź NIL;
                        fullFName: ROPE Ź NIL;
                        cp: FS.ComponentPositions;
                        [wd, cp] Ź FS.ExpandName[self.file ! FS.Error => CONTINUE];
                        IF wd # NIL THEN wd Ź Rope.Substr[wd, 0, cp.base.start];
                        [fullFName, cp] Ź FS.ExpandName[selection, wd ! FS.Error => {MessageWindow.Append[error.explanation, TRUE]; MessageWindow.Blink[]; 
                        CONTINUE}];
                        IF fullFName # NIL THEN {self.file Ź fullFName; Queue[$Save]};
                        };
                    $Undo => {
                        Queue[$Undo];
                        <<Records touchup box>>
                        QueueTouchUp[];
                        };
                    $Break => {
                        Queue[$Break];
                        QueueTouchUp[];
                        };
                    ENDCASE => {
                        WITH Atom.GetProp[atom, registrationKey] SELECT FROM
                            pointModifier: PointModifier => {
                                Queue[pointModifier];
                                QueueTouchUp[];
                                };
                            ENDCASE => Unknown[];
                        };
                };
            outline: Outline => {
                Queue[$ClearSel, $Idempotent];
                Queue[outline];
                QueuePaintAll[];
                };
            mousePlace: REF VEC => {
                markedPoint: MarkedPoint Ź [mousePlace.x, mousePlace.y, FALSE, sample];
                IF InputFocus.GetInputFocus[].owner # viewer THEN InputFocus.SetInputFocus[viewer];
                SELECT input.rest.first FROM
                    $AddPt => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$AddPt, $Ordinary, markedPoint];
                        Queue[$NewPt];
                        Queue[$InvertSel, $AutoInverse];
                        };
                    $DeletePt => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$GrabPt];
                        Queue[$DeleteGrabbed];
                        <<Records touchup box>>
                        Queue[$InvertSel, $AutoInverse];
                        QueueTouchUp[];
                        };
                    $ExtendSelection => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$ExtendSel, $Idempotent, markedPoint];
                        Queue[$InvertSel, $AutoInverse];
                        };
                    $GrabPt => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$GrabPt, $Ordinary, markedPoint];
                        Queue[$InvertGrabbed];
                        Queue[$EraseGrabbedPoint];
                        Queue[$RecordGrabbedBox];
                        Queue[$MoveTo, $Idempotent, markedPoint];
                        Queue[$InvertGrabbed, $AutoInverse];
                        Queue[$InvertSel, $AutoInverse];
                        };
                    $MovePt => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$InvertGrabbed, $AutoInverse];
                        Queue[$MoveTo, $Idempotent, markedPoint];
                        Queue[$InvertGrabbed, $AutoInverse];
                        Queue[$InvertSel, $AutoInverse];
                        };
                    $ReleasePt => {
                        Queue[$RecordGrabbedBox];
                        Queue[$ClearGrabbed];
                        QueueTouchUp[];
                        };
                    $StartMove => {
                        Queue[$StartMove, $Ordinary, markedPoint];
                        };
                    $Move => {
                        Queue[$Move, $Idempotent, markedPoint];
                        QueueTouchUp[];
                        };
                    $Bulge => {
                        Queue[$Bulge, $Idempotent, markedPoint];
                        QueueTouchUp[];
                        };
                    $SelectPt => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$SelectPt, $Idempotent, markedPoint];
                        Queue[$InvertSel, $AutoInverse];
                        };
                    $SelectTrajectory => {
                        Queue[$RecordSelectionBox];
                        Queue[$ClearSel, $Idempotent];
                        Queue[$SelectTrajectory, $Idempotent, markedPoint];
                        <<Will record boxes that need touchup>>
                        QueueTouchUp[];
                        };
                    $ShowPt => {
                        s: IO.STREAM Ź IO.ROS[];
                        s.PutF["%7.1g %7.1g ", IO.real[markedPoint.x], IO.real[markedPoint.y]];
                        MessageWindow.Append[s.RopeFromROS, TRUE];
                        };
                    $StartPt => {
                        Queue[$InvertSel, $AutoInverse];
                        Queue[$ClearSel, $Idempotent];
                        Queue[$RecordTrajectoryBox];
                        Queue[$StartPt, $Ordinary, markedPoint];
                        QueueTouchUp[];
                        Queue[$NewPt];
                        };
                    ENDCASE => Unknown[];
                };
            ENDCASE => Unknown[];
        EXITS Quit => NULL;
        }; 

    Dequeue: ENTRY PROC [tool: Tool] RETURNS [ref: REF] ~ {
        ENABLE UNWIND => NULL;
        IF tool.actionQueue.rest = NIL THEN {
            tool.actionQueue Ź NIL;
            <<Remove list head so Notify knows that DispatchProcess need restarting>>
            ref Ź NIL;
            <<Returning NIL will cause this DispatchProcess to go away.>>
            }
        ELSE {
            ref Ź tool.actionQueue.rest.first;
            tool.actionQueue.rest Ź tool.actionQueue.rest.rest;
            };
        };

    RegisterPointModifer: PUBLIC PROC [atom: ATOM, pointModifier: PointModifier] ~ {
        Atom.PutProp[atom, registrationKey, pointModifier];
        };

    RootViewer: PROC [viewer: Viewer] RETURNS [Viewer] ~ {
        WHILE viewer # NIL AND viewer.parent # NIL DO viewer Ź viewer.parent ENDLOOP;
        RETURN [viewer];
        };

    DispatchProcess: PROC [viewer: Viewer] ~ {
        dispatch: PROC [tool: Tool] ~ {
            root: Viewer ~ RootViewer[viewer];
            ref: REF;
            box: PaintRectangle Ź [xMin: 999999, yMin: 999999, xMax: -999999, yMax: -999999];
            ResetBBox: PROC ~ {box Ź [xMin: 999999, yMin: 999999, xMax: -999999, yMax: -999999]};
            slop: REAL ~ 5;
            BBPoint: PROC [markedPoint: MarkedPoint] ~ {
                box.xMin Ź  MIN[box.xMin, markedPoint.x-slop];
                box.xMax Ź  MAX[box.xMax, markedPoint.x+slop];
                box.yMin Ź  MIN[box.yMin, markedPoint.y-slop];
                box.yMax Ź  MAX[box.yMax, markedPoint.y+slop];
                };
            RecordBBox: PROC ~ {
                IF box.xMin>box.xMax THEN RETURN;
                FOR paintList: LIST OF PaintRectangle Ź tool.paintRectangles, paintList.rest UNTIL paintList = NIL DO
                    old: PaintRectangle ~ paintList.first;
                    IF old.xMin<=box.xMin
                    AND old.yMin<=box.yMin
                    AND old.xMax>=box.xMax
                    AND old.yMax>=box.yMax THEN {
                        ResetBBox[];
                        RETURN;
                        };
                    IF box.xMin<=old.xMin
                    AND box.yMin<=old.yMin
                    AND box.xMax>=old.xMax
                    AND box.yMax>=old.yMax THEN {
                        paintList.first Ź box;
                        ResetBBox[];
                        RETURN;
                        };
                    ENDLOOP;
                tool.paintRectangles Ź CONS[box, tool.paintRectangles];
                };
            BoundPoints: PROC [list: LIST OF MarkedPoint, count: NAT] ~ {
                FOR i: NAT IN [0..count) WHILE list # NIL DO
                    IF list.first.kind # open THEN BBPoint[list.first];
                    list Ź list.rest;
                    ENDLOOP;
                };
            BoundSelected: PROC ~ {BoundPoints[tool.selected, tool.selectedCount+2]};
            RecordPoints: PROC [list: LIST OF MarkedPoint, count: NAT] ~ {
                BoundPoints[list, count];
                RecordBBox[];
                };
            WHILE (ref Ź Dequeue[tool]) # NIL DO
                action: ATOM Ź $NothingMoreToDo;
                markedPoint: MarkedPoint;
                WITH ref SELECT FROM
                    atom: ATOM => action Ź atom;
                    actionWithPoint: ActionWithPoint => {
                        action Ź actionWithPoint.atom;
                        markedPoint Ź actionWithPoint.markedPoint;
                        };
                    pointModifier: PointModifier => {
                        IF tool.selected # NIL THEN {
                            changed: BOOL;
                            newCount: INT;
                            BoundPoints[tool.selected, tool.selectedCount+2];
                            [changed, newCount] Ź pointModifier.pointModifyProc[pointModifier, tool.selected, tool.selectedCount];
                            IF changed
                                THEN {
                                    RecordPoints[tool.selected, tool.selectedCount+2];
                                    IF newCount >= 0 THEN tool.selectedCount Ź newCount;
                                    ViewerOps.SetNewVersion[root]
                                    }
                                ELSE ResetBBox[];
                            };
                        };
                    outline: Outline => {
                        tool.outline Ź outline;
                        };
                    ENDCASE => ERROR;
                SELECT action FROM
                    $NothingMoreToDo => NULL;
                    $Save => {
                        [] Ź ViewerOps.SaveViewer[root];
                        };
                    $StartPt => {
                        tool.selected Ź NIL;
                        tool.selectedCount Ź 0;
                        tool.grabbed Ź NIL;
                        tool.grabbedCount Ź 0;
                        tool.outline Ź CONS[LIST[header, markedPoint], tool.outline];
                        ViewerOps.SetNewVersion[root];
                        };
                    $SelectTrajectory => {
                        BoundPoints[tool.outline.first, LAST[NAT]];
                        IF SelectNewTrajectory[tool, markedPoint]
                        THEN RecordPoints[tool.outline.first, LAST[NAT]]
                        ELSE ResetBBox[];
                        };
                    $AddPt => {
                        IF tool.outline.first.rest # NIL AND tool.outline.rest.rest # NIL THEN {
                            tool.outline.first.rest.first.kind Ź sample;
                            };
                        tool.outline.first.rest Ź CONS[markedPoint, tool.outline.first.rest];
                        ViewerOps.SetNewVersion[root];
                        };
                    $Clear => {
                        tool.outline.first.rest Ź tool.grabbed Ź tool.selected Ź NIL;
                        tool.outline.rest Ź NIL;
                        tool.grabbedCount Ź tool.selectedCount Ź 0;
                        ViewerOps.SetNewVersion[root];
                        };
                    $Copy => {
                        IF tool.outline # NIL AND tool.selected # NIL AND tool.selectedCount > 0 THEN {
                            tool.outline.rest Ź CONS[TrajectoryFromPoints[tool.selected.rest, tool.selectedCount], tool.outline.rest];
                            };
                        ViewerOps.SetNewVersion[root];
                        };
                    $ClearGrabbed => {
                        tool.grabbed Ź NIL;
                        tool.grabbedCount Ź 0;
                        };
                    $ClearSel => {
                        tool.selected Ź NIL;
                        tool.selectedCount Ź 0;
                        tool.grabbed Ź NIL;
                        tool.grabbedCount Ź 0;
                        tool.undoList Ź NIL;
                        };
                    $DeleteGrabbed => {
                        IF tool.outline.first.rest # NIL AND tool.grabbed # NIL THEN {
                            BBPoint[tool.grabbed.first];
                            BBPoint[tool.grabbed.rest.first];
                            IF tool.grabbed.rest.rest # NIL THEN BBPoint[tool.grabbed.rest.rest.first];
                            RecordBBox[];
                            markedPoint Ź tool.grabbed.rest.first;
                            tool.grabbed.rest Ź tool.grabbed.rest.rest;
                            };
                        tool.grabbed Ź tool.selected Ź NIL;
                        tool.grabbedCount Ź tool.selectedCount Ź 0;
                        ViewerOps.SetNewVersion[root];
                        };
                    $DeleteSelected => {
                        SaveForUndo[tool];
                        IF tool.selected # NIL THEN {
                            RecordPoints[tool.selected, tool.selectedCount+2];
                            THROUGH [0..tool.selectedCount) WHILE tool.selected.rest # NIL DO
                                tool.selected.rest Ź tool.selected.rest.rest;
                                ENDLOOP;
                            };
                        tool.selected Ź NIL;
                        tool.selectedCount Ź 0;
                        tool.grabbed Ź NIL;
                        tool.grabbedCount Ź 0;
                        tool.undoList Ź NIL;
                        ViewerOps.SetNewVersion[root];
                        };
                    $Break => {
                        IF tool.selected # NIL AND tool.selected.rest # NIL THEN {
                            BBPoint[tool.selected.first];
                            BBPoint[tool.selected.rest.first];
                            BreakCurrentTrajectory[tool];
                            RecordBBox[];
                            };
                        tool.grabbed Ź NIL;
                        tool.grabbedCount Ź 0;
                        tool.undoList Ź NIL;
                        ViewerOps.SetNewVersion[root];
                        };
                    $ExtendSel => IF tool.selected # NIL THEN {
                        new: LIST OF MarkedPoint Ź NIL;
                        count: INT Ź 0;
                        grabbedToGo: INT Ź LAST[INT];
                        selectedToGo: INT Ź LAST[INT];
                        GrabPoint[tool, markedPoint];
                        FOR list: LIST OF MarkedPoint Ź tool.outline.first, list.rest
                        UNTIL list = NIL OR (grabbedToGo<=0 AND selectedToGo<=0) DO
                            IF list = tool.grabbed THEN {
                                IF new = NIL THEN new Ź tool.grabbed;
                                grabbedToGo Ź tool.grabbedCount;
                                };
                            IF list = tool.selected THEN {
                                IF new = NIL THEN new Ź tool.selected;
                                selectedToGo Ź tool.selectedCount;
                                };
                            IF new # NIL THEN count Ź count + 1;
                            grabbedToGo Ź grabbedToGo - 1;
                            selectedToGo Ź selectedToGo - 1;
                            ENDLOOP;
                        tool.selected Ź new;
                        tool.selectedCount Ź count;
                        tool.grabbed Ź NIL;
                        tool.grabbedCount Ź 0;
                        tool.undoList Ź NIL;
                        };
                    $GrabPt => GrabPoint[tool, markedPoint];
                    $MoveTo => IF tool.outline # NIL THEN {
                        head: LIST OF MarkedPoint Ź tool.outline.first;
                        markedPoint.kind Ź tool.grabbed.rest.first.kind;
                        tool.grabbed.rest.first Ź markedPoint;
                        IF tool.grabbed.rest.rest = NIL AND head.first.kind # open THEN {
                            head.first.x Ź markedPoint.x;
                            head.first.y Ź markedPoint.y;
                            };
                        ViewerOps.SetNewVersion[root];
                        };
                    $RecordGrabbedBox => RecordPoints[tool.grabbed, tool.grabbedCount+2];
                    $RecordTrajectoryBox => RecordPoints[tool.outline.first, LAST[NAT]];
                    $RecordSelectionBox => RecordPoints[tool.selected, tool.selectedCount];
                    $StartMove => {
                        tool.moveSource Ź markedPoint;
                        };
                    $Move => {
                        deltaX: REAL ~ markedPoint.x - tool.moveSource.x;
                        deltaY: REAL ~ markedPoint.y - tool.moveSource.y;
                        tool.moveSource Ź markedPoint;
                        IF tool.selected#NIL THEN {
                            p: LIST OF MarkedPoint Ź tool.selected.rest;
                            BoundSelected[];
                            FOR i: INT IN [0..tool.selectedCount) WHILE p # NIL DO
                                p.first.x Ź p.first.x + deltaX;
                                p.first.y Ź p.first.y + deltaY;
                                p Ź p.rest;
                                ENDLOOP;
                            BoundSelected[];
                            RecordBBox[];
                            ViewerOps.SetNewVersion[root];
                            };
                        };
                    $Bulge => {
                        <<Figure out the coefficients of the bilinear analytic function that maps the endpoints of the current selection to themselves, and 
                        tool.moveSource to markedPoint.>>
                        IF tool.selected#NIL AND tool.selectedCount > 2 THEN {
                            p: LIST OF MarkedPoint Ź tool.selected.rest;
                            z0: COMPLEX ~ Complexify[p.first];
                            z1: COMPLEX ~ Complexify[tool.moveSource];
                            z2: COMPLEX ~ Complexify[FetchPt[p, tool.selectedCount-1]];
                            w1: COMPLEX ~ Complexify[markedPoint];
                            b: ARRAY [0..4) OF COMPLEX ~ FindBilinearParam[[z0, z1, z2], [z0, w1, z2]];
                            IF b # bilinearIdentity THEN {
                                BoundSelected[];
                                FOR i: INT IN [0..tool.selectedCount) WHILE p # NIL DO
                                    v: COMPLEX ~ BilinearEval[b, Complexify[p.first]];
                                    p.first.x Ź v.x;
                                    p.first.y Ź v.y;
                                    p Ź p.rest;
                                    ENDLOOP;
                                BoundSelected[];
                                RecordBBox[];
                                ViewerOps.SetNewVersion[root];
                                };
                            tool.moveSource Ź markedPoint;
                            };
                        };
                    $ReverseTrajectory => {
                        IF tool.outline # NIL THEN {
                            old: Trajectory Ź tool.outline.first.rest;
                            tool.outline.first.rest Ź NIL;
                            WHILE old # NIL DO
                                temp: Trajectory Ź old;
                                old Ź old.rest;
                                temp.rest Ź tool.outline.first.rest;
                                tool.outline.first.rest Ź temp
                                ENDLOOP;
                            };
                        ViewerOps.SetNewVersion[root];
                        };
                    $SelectPt => {
                        GrabPoint[tool, markedPoint];
                        IF tool.selected # tool.grabbed THEN {
                            tool.selected Ź tool.grabbed;
                            tool.selectedCount Ź tool.grabbedCount;
                            };
                        tool.grabbed Ź NIL;
                        tool.grabbedCount Ź 0;
                        };
                    $Undo => {
                        BoundSelected[];
                        IF tool.selected # NIL AND tool.selectedCount > 0 AND tool.undoList # NIL THEN {
                            end: LIST OF MarkedPoint Ź tool.selected.rest;
                            undoList: LIST OF MarkedPoint Ź tool.undoList;
                            undoEnd: LIST OF MarkedPoint Ź NIL;
                            count: NAT Ź 0;
                            FOR i: NAT IN [0..tool.selectedCount-1) DO end Ź end.rest; ENDLOOP;
                            FOR p: LIST OF MarkedPoint Ź tool.undoList, p.rest UNTIL p=NIL DO
                                count Ź count + 1;
                                IF p.rest = NIL THEN undoEnd Ź p;
                                ENDLOOP;
                            undoEnd.rest Ź end.rest;
                            tool.undoList Ź tool.selected.rest;
                            tool.selected.rest Ź undoList;
                            tool.selectedCount Ź count;
                            end.rest Ź NIL;
                            };
                        BoundSelected[];
                        RecordBBox[];
                        ViewerOps.SetNewVersion[root];
                        };
                    $PaintAll, $TouchUp => {
                        ViewerOps.PaintViewer[root, client, FALSE, action];
                        tool.paintRectangles Ź NIL;
                        };
                    $NewPt, $InvertGrabbed, $InvertSel, $EraseGrabbedPoint => {
                        ViewerOps.PaintViewer[root, client, FALSE, action];
                        };
                    ENDCASE => ERROR;
                IF paranoid THEN CheckConsistency[tool];
                ENDLOOP;
            };
        DoWithLock[viewer, dispatch];
        };

    paranoid: BOOL Ź TRUE;

    SaveForUndo: PROC [tool: Tool] = {
        new: LIST OF MarkedPoint Ź NIL;
        end: LIST OF MarkedPoint Ź NIL;
        scratch: LIST OF MarkedPoint Ź tool.undoList;
        tool.undoList Ź NIL;
        IF tool.selected # NIL THEN {
            list: LIST OF MarkedPoint Ź tool.selected.rest;
            FOR i: NAT IN [0..tool.selectedCount) WHILE list # NIL DO
                node: LIST OF MarkedPoint Ź NIL;
                IF scratch = NIL THEN node Ź LIST[list.first]
                ELSE {
                    node Ź scratch;
                    scratch Ź scratch.rest;
                    node.first Ź list.first;
                    node.rest Ź NIL;
                    };
                IF end # NIL THEN {end.rest Ź node; end Ź node.rest} ELSE new Ź end Ź node;
                list Ź list.rest;
                ENDLOOP;
            };
        tool.undoList Ź new;
        UNTIL scratch = NIL DO
            t: LIST OF MarkedPoint Ź scratch;
            scratch Ź scratch.rest;
            t.rest Ź NIL;
            ENDLOOP;
        };

    SmoothModifier: PointModifyProc ~ {
        IF pointList # NIL AND count > 0 THEN {
            list: LIST OF MarkedPoint Ź pointList.rest;
            prev: MarkedPoint Ź pointList.first;
            IF prev.isHeader AND list # NIL THEN prev Ź list.first;
            FOR i: INT IN [0..count) WHILE list # NIL DO
                current: MarkedPoint Ź list.first;
                next: MarkedPoint Ź IF list.rest = NIL THEN current ELSE list.rest.first;
                current.x Ź (2*current.x + prev.x + next.x)/4;
                current.y Ź (2*current.y + prev.y + next.y)/4;
                prev Ź list.first;
                IF current.kind # corner THEN list.first Ź current;
                list Ź list.rest;
                ENDLOOP;
            }
        ELSE changed Ź FALSE;
        };

    CornerModifierDataRep: TYPE ~ RECORD [old, new: PointKind];

    CornerModifier: PointModifyProc ~ {
        data: REF CornerModifierDataRep ~ NARROW[self.data];
        IF pointList # NIL AND count > 0 THEN {
            list: LIST OF MarkedPoint Ź pointList.rest;
            FOR i: INT IN [0..count) WHILE list # NIL DO
                IF list.first.kind = data.old THEN list.first.kind Ź data.new;
                list Ź list.rest;
                ENDLOOP;
            }
        ELSE changed Ź FALSE;
        };

    DoubleModifier: PointModifyProc ~ {
        IF pointList # NIL AND count > 0 THEN {
            list: LIST OF MarkedPoint Ź pointList.rest;
            newCount Ź count;
            FOR i: INT IN [0..count) WHILE list # NIL DO
                pt: MarkedPoint Ź list.first;
                IF pt.kind = sample OR pt.kind = corner THEN {
                    pt.kind Ź sample;
                    list.rest Ź CONS[pt, list.rest];
                    list Ź list.rest;
                    newCount Ź newCount + 1;
                    };
                list Ź list.rest;
                ENDLOOP;
            IF newCount > 2 THEN {
                [] Ź SmoothModifier[NIL, pointList.rest, newCount-2];
                };
            }
        ELSE changed Ź FALSE;
        };

    UnDoubleModifier: PointModifyProc ~ {
        IF pointList # NIL AND count > 0 THEN {
            list: LIST OF MarkedPoint Ź pointList;
            flipFlop: BOOL Ź FALSE;
            newCount Ź count;
            FOR i: INT IN [0..count) WHILE list.rest # NIL DO
                next: LIST OF MarkedPoint Ź list.rest;
                IF next.first.kind = sample AND flipFlop THEN {
                    list.rest Ź next.rest;
                    newCount Ź newCount - 1;
                    };
                flipFlop Ź NOT flipFlop;
                list Ź next;
                ENDLOOP;
            }
        ELSE changed Ź FALSE;
        };

    TSquareModifier: PointModifyProc ~ {
        IF pointList # NIL AND count > 0 THEN {
            list: LIST OF MarkedPoint Ź pointList.rest;
            firstPt: MarkedPoint ~ pointList.rest.first;
            lastPt: MarkedPoint Ź firstPt;
            xBar: REAL Ź 0;
            yBar: REAL Ź 0;
            FOR i: INT IN [0..count) WHILE list # NIL DO
                cur: MarkedPoint Ź list.first;
                IF i = count-1 OR list.rest = NIL THEN {lastPt Ź cur};
                xBar Ź xBar + cur.x;
                yBar Ź yBar + cur.y;
                list Ź list.rest;
                ENDLOOP;
            list Ź pointList.rest;
            xBar Ź xBar/count;
            yBar Ź yBar/count;
            IF ABS[lastPt.x-firstPt.x] > ABS[lastPt.y-firstPt.y] THEN {
                y: REAL Ź yBar;
                FOR i: INT IN [0..count) WHILE list # NIL DO
                    cur: MarkedPoint Ź list.first;
                    cur.x Ź firstPt.x + (lastPt.x-firstPt.x)*i/(count-1);
                    cur.y Ź y;
                    list.first Ź cur;
                    list Ź list.rest;
                    ENDLOOP;
                }
            ELSE IF lastPt.y # firstPt.y THEN {
                x: REAL Ź xBar;
                FOR i: INT IN [0..count) WHILE list # NIL DO
                    cur: MarkedPoint Ź list.first;
                    cur.x Ź x;
                    cur.y Ź firstPt.y + (lastPt.y-firstPt.y)*i/(count-1);
                    list.first Ź cur;
                    list Ź list.rest;
                    ENDLOOP;
                };
            RETURN [TRUE];
            };
        RETURN [FALSE]
        };

    MenuAction: Menus.ClickProc = {Notify[NARROW[parent], LIST[clientData]]};

<<AddMenuItem: PUBLIC PROC [atom: ATOM] = {>>
<<name: ROPE ~ Atom.GetPName[atom];>>
<<menu: Menus.Menu _ NARROW[bsClass.menu];>>
<<ResetViewerMenu: PROC [v: Viewer] RETURNS [BOOL _ TRUE] ~ {>>
<<IF v.class = viewerClass THEN ViewerOps.SetMenu[v, menu];>>
<<};>>
<<Menus.AppendMenuEntry[>>
<<menu: menu, line: 1,>>
<<entry: Menus.CreateEntry[>>
<<name: name,>>
<<proc: MenuAction,>>
<<clientData: atom,>>
<<documentation: NIL>>
<<]>>
<<];>>
<<ViewerOps.EnumerateViewers[ResetViewerMenu];>>
<<};>>
<<>>
    CreateMenu: PROC RETURNS [Menus.Menu] = {
        menu: Menus.Menu Ź Menus.CreateMenu[lines: 2];
        bsMenu: Menus.Menu Ź Menus.CopyMenu[BiScrollers.bsMenu];
        Menus.AppendMenuEntry[
            menu: menu, line: 0,
            entry: Menus.CopyEntry[Menus.FindEntry[bsMenu, "Rotate"]]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 0,
            entry: Menus.CopyEntry[Menus.FindEntry[bsMenu, "Scale"]]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 1,
            entry: Menus.CreateEntry[
                name: "Clear",
                proc: MenuAction,
                clientData: $Clear,
                documentation: "Clear the viewer"
                ]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 1,
            entry: Menus.CreateEntry[
                name: "Refresh",
                proc: MenuAction,
                clientData: $Refresh,
                documentation: "Refresh the viewer"
                ]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 1,
            entry: Menus.CreateEntry[
                name: "Save",
                proc: MenuAction,
                clientData: $Save,
                documentation: "Save the samples"
                ]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 1,
            entry: Menus.CreateEntry[
                name: "Store",
                proc: MenuAction,
                clientData: $Store,
                documentation: "Save the samples with a new file name"
                ]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 1,
            entry: Menus.CreateEntry[
                name: "Smooth",
                proc: MenuAction,
                clientData: $Smooth,
                documentation: "Smooth out the selected samples"
                ]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 1,
            entry: Menus.CreateEntry[
                name: "Reverse",
                proc: MenuAction,
                clientData: $Reverse,
                documentation: "Reverse the order of the points in the current trajectory"
                ]
            ];
        Menus.AppendMenuEntry[
            menu: menu, line: 1,
            entry: Menus.CreateEntry[
                name: "Delete",
                proc: MenuAction,
                clientData: $Delete,
                documentation: "Delete the currently selected points"
                ]
            ];
        RETURN [menu];
        };

    Break: PROC [char: CHAR] RETURNS [IO.CharClass] = {
        IF char = '_ OR char = '; THEN RETURN [break];
        IF char = '  OR char = '     OR char = ', OR char = '\n THEN RETURN [sepr];
        RETURN [other];
        };

    GetToken: PROC [stream: IO.STREAM, breakProc: IO.BreakProc] RETURNS [rope: ROPE Ź NIL] ~ {
        rope Ź stream.GetTokenRope[breakProc ! IO.EndOfStream => CONTINUE].token
        };

    SampledCurveEditCommand: Commander.CommandProc ~ {
        stream: IO.STREAM Ź IO.RIS[cmd.commandLine];
        name: ROPE Ź GetToken[stream, Break];
        IF name # NIL THEN {
            name Ź FS.ExpandName[name ! FS.Error => {cmd.err.PutRope[error.explanation]; name Ź NIL; CONTINUE}].fullFName;
            };
        IF name = NIL THEN {
            [] Ź bsStyle.CreateBiScroller[bsClass, [name: "Sampled Curve Editor [No File]", file: NIL, data: NewData[]]]
            }
        ELSE {
            [] Ź bsStyle.CreateBiScroller[bsClass, [name: Rope.Concat["Sampled Curve Editor ", name], file: name, label: name, data: 
            NewData[]]];
            };
        };

    CreateViewer: PUBLIC PROC [info: ViewerClasses.ViewerRec] RETURNS [Viewer] ~ {
        biScroller: BiScrollers.BiScroller;
        IF info.label = NIL THEN info.label Ź info.file;
        IF info.name = NIL THEN info.name Ź Rope.Concat["Sampled Curve Editor ", info.file];
        info.data Ź NewData[];
        biScroller Ź bsStyle.CreateBiScroller[bsClass, info];
        RETURN [BiScrollers.QuaViewer[biScroller]]
        };

<<viewerClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [>>
<<paint:  PaintProc,>>
<<notify: Notify,>>
<<init: InitViewer,>>
<<save: SaveProc,>>
<<menu: CreateMenu[],>>
<<tipTable: TIPUser.InstantiateNewTIPTable["SampledCurveEdit.TIP"]>>
<<]];>>
<<>>
    Extrema: BiScrollers.ExtremaProc ~ {
        <<PROC [clientData: REF ANY, direction: VEC] RETURNS [min, max: VEC];>>
        Locked: PROC [tool: Tool] ~ {
            box: PaintRectangle Ź [xMin: 999999, yMin: 999999, xMax: -999999, yMax: -999999];
            BBPoint: PROC [markedPoint: MarkedPoint] ~ INLINE {
                box.xMin Ź  MIN[box.xMin, markedPoint.x-slop];
                box.xMax Ź  MAX[box.xMax, markedPoint.x+slop];
                box.yMin Ź  MIN[box.yMin, markedPoint.y-slop];
                box.yMax Ź  MAX[box.yMax, markedPoint.y+slop];
                };
            slop: REAL ~ 5;
            BoundPoints: PROC [list: LIST OF MarkedPoint] ~ {
                WHILE list # NIL DO
                    IF list.first.kind # open THEN BBPoint[list.first];
                    list Ź list.rest;
                    ENDLOOP;
                };
            FOR t: LIST OF Trajectory Ź tool.outline, t.rest UNTIL t=NIL DO
                BoundPoints[t.first.rest];
                ENDLOOP;
            IF box.xMin < box.yMin THEN {min Ź [0,0]; max Ź [1,1]}
            ELSE [min, max] Ź Geom2D.ExtremaOfRect[[box.xMin, box.yMin, box.xMax-box.xMin, box.yMax-box.yMin], direction];
            };
        min Ź max Ź [0,0];
        DoWithLockedData[clientData, Locked];
        };

    bsStyle: BiScrollers.BiScrollerStyle;
    bsClass: BiScrollers.BiScrollerClass;

    registrationKey: REF TEXT ~ "SampledCurveEdit";

    Init: PROC ~ {
        bsStyle Ź BiScrollers.GetStyle[]; -- default gets BiScrollersButtonned
        bsClass Ź bsStyle.NewBiScrollerClass[[
            flavor: $SampledCurveEdit,
            extrema: Extrema,
            notify: Notify,
            paint: PaintProc,
            destroy: NIL,
            get: NIL,
            init: InitViewer,
            save: SaveProc,
            menu: CreateMenu[],
            tipTable: TIPUser.InstantiateNewTIPTable["SampledCurveEdit.tip"],
            mayStretch: FALSE, -- NOT OK to scale X and Y differently
            preserve: [X: 0.5, Y: 0.5] --this specifies point that stays fixed when viewer size changes
            ]];
        RegisterPointModifer[$Smooth, NEW[PointModifierRep Ź [SmoothModifier, NIL]]];
        RegisterPointModifer[$Double, NEW[PointModifierRep Ź [DoubleModifier, NIL]]];
        RegisterPointModifer[$UnDouble, NEW[PointModifierRep Ź [UnDoubleModifier, NIL]]];
        RegisterPointModifer[$TSquare, NEW[PointModifierRep Ź [TSquareModifier, NIL]]];
        RegisterPointModifer[$Corner, NEW[PointModifierRep Ź [CornerModifier, NEW[CornerModifierDataRep Ź [sample, corner]]]]];
        RegisterPointModifer[$NonCorner, NEW[PointModifierRep Ź [CornerModifier, NEW[CornerModifierDataRep Ź [corner, sample]]]]];
    <<ViewerOps.RegisterViewerClass[$SampledCurveEdit, viewerClass];>>
        Commander.Register["SampledCurveEdit", SampledCurveEditCommand, "Create a viewer to edit a sampled curve"];
        };

    Complexify: PROC [m: MarkedPoint] RETURNS [COMPLEX] ~ INLINE {
        RETURN [[m.x, m.y]]
        };

    BilinearEval: PROC [b: ARRAY [0..4) OF COMPLEX, z: COMPLEX] RETURNS [COMPLEX] ~ {
        <<Computes (b0z+b1)/(b2z+b3)>>
        num: COMPLEX ~ Complex.Add[Complex.Mul[b[0], z], b[1]];
        denom: COMPLEX ~ Complex.Add[Complex.Mul[b[2], z], b[3]];
        w: COMPLEX ~ Complex.Div[num, denom];
        RETURN [w]
        };

    bilinearIdentity: ARRAY [0..4) OF COMPLEX ~ [ [1, 0], [0, 0], [0, 0], [1, 0] ];
    maxAbs: REAL Ź 10000000;

    FindBilinearParam: PROC [z: ARRAY [0..3) OF COMPLEX, w: ARRAY [0..3) OF COMPLEX] RETURNS [ARRAY [0..4) OF COMPLEX] ~ {
    <<Finds parameters for BilinearEval that map zi to wi>>
    <<Returns parameters for identity mapping if exceptions occur>>
        A: ARRAY [0..4) OF ARRAY [0..4) OF COMPLEX Ź ALL[ALL[[0,0]]];
        p: ARRAY [0..4) OF COMPLEX Ź ALL[[0,0]];
        b: ARRAY [0..4) OF COMPLEX ~ [ [0,0], [0,0], [0,0], [1,0] ];
        ok: BOOL Ź TRUE;
        FOR i: NAT IN [0..3) DO
            A[i] Ź [ z[i], [1, 0], Complex.Neg[Complex.Mul[z[i], w[i]]], Complex.Neg[w[i]]];
            ENDLOOP;
        A[3] Ź [ [0,0], [0,0], [1,0], [0,0] ];
        p Ź Solve4[A, b ! Real.RealException => {ok Ź FALSE; CONTINUE}];
        IF NOT ok THEN {
            A[3] Ź [ [0,0], [0,0], [0,0], [1,0] ];
            p Ź Solve4[A, b ! Real.RealException => {ok Ź FALSE; CONTINUE}];
            };
        FOR i: NAT IN [0..4) DO
            IF ABS[p[i].x] > maxAbs OR ABS[p[i].y] > maxAbs THEN ok Ź FALSE;
            ENDLOOP;
        IF NOT ok THEN p Ź bilinearIdentity;
        RETURN [p]
        };

    Solve4: PROC [A: ARRAY [0..4) OF ARRAY [0..4) OF COMPLEX, b: ARRAY [0..4) OF COMPLEX] RETURNS [x: ARRAY [0..4) OF COMPLEX Ź 
    ALL[[0,0]]] ~ {
    <<solve Ax=b by Gaussian Elimination>>
        SubtractMultiple: PROC [u, v, r: COMPLEX] RETURNS [COMPLEX] ~ {
            <<Calculates u - v*r>>
            RETURN [Complex.Sub[u, Complex.Mul[v, r]]]
            };
        n: NAT = 4;
        FOR i: [0..n) IN [0..n) DO
            bestk: [0..n) Ź i;
            FOR k: [0..n) IN [i..n) DO
                IF Complex.SqrAbs[A[k][i]] > Complex.SqrAbs[A[bestk][i]] THEN bestk Ź k;
                ENDLOOP;
            {t: ARRAY [0..n) OF COMPLEX Ź A[i]; A[i] Ź A[bestk]; A[bestk] Ź t};
            {t: COMPLEX Ź b[i]; b[i] Ź b[bestk]; b[bestk] Ź t};
            FOR k: [0..n) IN (i..n) DO
                r: COMPLEX = Complex.Div[A[k][i], A[i][i]];
                <<Singular A causes divide by zero>>
                FOR j: [0..n) IN [i..n) DO
                    A[k][j] Ź SubtractMultiple[A[k][j], A[i][j], r];
                    ENDLOOP;
                b[k] Ź SubtractMultiple[b[k], b[i], r];
                ENDLOOP;
            ENDLOOP;
    <<Now A is upper-triangular, so back substitute>>
        FOR i: [0..n) DECREASING IN [0..n) DO
            xi: COMPLEX Ź b[i];
            FOR j: [0..n) IN (i..n) DO
                xi Ź SubtractMultiple[xi, A[i][j], x[j]];
                ENDLOOP;
            x[i] Ź Complex.Div[xi, A[i][i]];
            ENDLOOP;
        };

    Init[];

    END.