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,
grabbed: LIST OF MarkedPoint,
grabbedCount: NAT,
selected: LIST OF MarkedPoint Ź NIL,
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] = {
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
= {
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];
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];
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];
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];
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];
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;
ref Ź NIL;
}
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 => {
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]]};

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]]
};

Extrema: BiScrollers.ExtremaProc ~ {
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]]]]];
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] ~ {
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] ~ {
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]]] ~ {
SubtractMultiple: PROC [u, v, r: COMPLEX] RETURNS [COMPLEX] ~ {
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]];
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;
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.


     
SampledCurveEditImpl.mesa
Copyright Ó 1983, 1992 Xerox Corporation.  All rights reserved.
Michael Plass, June 30, 1992 4:47 pm PDT
The first trajectory in the outline is the one currently being edited.
Points to the item before the point or points actually grabbed.
Points to the item before the point actually selected.
Breaks the trajectory before the current selection; turns a closed loop into an open trajectory, or an open trajectory into two trajectories.
PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL]
List head is present iff DispatchProcess is alive.
Records touchup box
Records touchup box
Records touchup box
Will record boxes that need touchup
Remove list head so Notify knows that DispatchProcess need restarting
Returning NIL will cause this DispatchProcess to go away.
Figure out the coefficients of the bilinear analytic function that maps the endpoints of the current selection to themselves, and tool.moveSource to markedPoint.
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];
};

viewerClass: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [
paint:  PaintProc,
notify: Notify,
init: InitViewer,
save: SaveProc,
menu: CreateMenu[],
tipTable: TIPUser.InstantiateNewTIPTable["SampledCurveEdit.TIP"]
]];

PROC [clientData: REF ANY, direction: VEC] RETURNS [min, max: VEC];
ViewerOps.RegisterViewerClass[$SampledCurveEdit, viewerClass];
Computes (b0z+b1)/(b2z+b3)
Finds parameters for BilinearEval that map zi to wi
Returns parameters for identity mapping if exceptions occur
solve Ax=b by Gaussian Elimination
Calculates u - v*r
Singular A causes divide by zero
Now A is upper-triangular, so back substitute
Ę9?  "cedarcode" styleNewlineDelimiter
 J	Ďe3?J(codeĎk		KKK
KKKKKKKKKKKKKKKKKKKK

KKK Đln#KEZÄKK K)KKK K		KK"KK
		JF	J?K
$J66KK
$K!K!K'KK Ďn'K#0K#+KK	*HKKK*KKKK(KK0K.KKK&.K*7K*7KKK;K9K#K"KK KKK  K
K
"KKKKK  
#KKKK  ! 
(K K0EKKK3KK	K
K K?]KKK &K@aKKKKKK6KK%K	1K	(KKK	
&uK KKKKK;YKBKKKKK

KKKKKKK"KKKHUKKHUKK1EK"KKK	KK  cK KKKKKK  
?K@@KK  	@ K)fK(K$K +3KKKKKK!K		KKKK K 6 KF3ť $K4	K$$K  KKK&5K'KK!KK66'8KDDK KKKKKK<KKK	KK1KK  
	/DKK	K''K..K..K''K..K..KK''K..K''K..KKKK  HK+K
KK  	2J
B&.K/NKKK'KK".K	(K",KKK
)KKKKKKKKK  	*@ #?K#K5K)EKKKKKK''K""K%K'K8?/KKKKKK  	.HK)<K5K"/(KK6KK 2KKKK  	BK  	ZKKKK
*#?@K(K07KKK	KK*KK
]K!KKK  	
 5KKK*KK(K07K2?KKKK K#K*K Ďb	"JOOKK':K$K''KAAKKKK''7eK&&KBBKK''7eK&& KZZKKKK  KKK/K'' ,K4K""K33KKKK.KKK00K8KK66KK K55K#K)KK#KKKKK 2KKK""K!!KK2K!.K''8KK66KKKK--KKK K/#KKKK K) MK2K)KK,K9"-KK7KKKK#K*K:KKKKK  [K	K,K&KKKKKKK  AKKK1KKKKKKK 
 
MK 6BKKK  J KKKK#K+K(K7KKKK  
'>K+KK Ą*KGK':K K	K""KK3KKK'7 
F^ 
"'K99KKKK	K
) (J22K-K>KKKKK	O.KNKKKKK#K<KK K"K\KKKKK K"K	
KKKK''KKKKKKKKKK3KKKK++JKK

K  KK  KKK  KK((K

KKK&5KKKK
;K(8K	3K'>K

JKKKKK%4!!KKKKKKKKKKK8
GK+"SK  K&&KK  KK  KJK  KKK  K,,K  KK  K''KKKK))K$$K  KK  K$$K))K$$K  KKKKKK**K

K''KKK((KKK  K++K  KKK33J#KKK	KGK$*KK  KKK((KKKKKKK	KK 
 7K%JEE
J99KK"K3KKK  #PK33KK  
6K
MK
KK  *
K""K	KQK 	FUK ,K.K.K.K.K 
K!7eK&&KKKKKKKKKKKKKKK7K
 =,K3KKKK 6I
 >KKK$K KK%%KK*K!!K	K
K11Kf
K22K4KKKKKKKKK

K KKKKKK%=KKK +K')K"0KKHK,KK'EKKK9=KK+KK

OKRjKKKKKKKKKKKK
>KK!!K'KKK&K+KK#K+KKKK22AK-KKKKKKKKK
:KK""KKKKKKKK+KKKKKK,=	;K%K KK&K"KK$KK KKKKKKKK(('K"/K0K&AKKKKKKEEK9DKGGKK

K%1K%1KK",K6KKKKKKKKKKĄĄ6K",K"K*K0;K&K1KK6K(2KKKKKKKKKKKK*KKKK$KKKKKK&KK'KKKK

KPK".K
.K	#KK
C%AKK
!KKK#KKKKKKKKK$
3KK;;K$
3KKK
(KKKKK 
K  "KKK	-KK"/9K K-KKKKKK$KKKKKK!KK	KKK  #'K+K$K7,K"K		IK.K.KK3KKKKKK ;K  #K4'K+,K>KKKKKK  #'K+K,K.KK KKKKKK5KKKKK  %'K&K
K1K&/KKKK
KKKKKK  $'K+K,,KKK,KK6KKKKKKK;K,KK5K
KKKK#K,KK
K5KKKKKKKKK  

IK  )J!J(
 ;J9JJJJJJJJJ,,JJ  
)K.K8KK9KKK8KKKKKK!KKKKKKK#KKKKKKK!KKKKKKK6KKKKKKK0KKKKKKKJJKKKKKKK55KKKKK "cedar" style
 3K	.KHK	KK  
ZK'HKK  2K	,K%K	6nKKVlKKKKK  !NK##K0K=TKK5K$*KK )!MJJJJJJ@@JJ  $KC KQ 3K.K.K.K.KK 1K3KKK#?KKK6KjnKKK%KK K%%%%K /K  K"Ďc$F&KKKKKK		KKKKAK˘&9K˘@[KK%MK%MK 'QK&OK%.wK!%.zJ>>KkkKK 
 
>KKK  QK	ĎdŁŁŁKŁŁ7KŁŁ9K%K
KK K&OK  vJ,ŁŁ3J;;K	=K	(K"<KKPKK&K.@K&K.@KK@KK$K
KK    J""
 ?KK$*KKKK7HKK	CK(3!+J  K0KK'KKJ--
%KK)KK KKK KK KK K       Ŕ  â  