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