JunoTop.mesa

Coded May 1981 by Greg Nelson
Converted to use the Viewers window package by Donna Auguste
Last Edited by: Gnelson, January 17, 1984 11:32 am
Last Edited by: Maureen Stone January 19, 1984 12:08 pm
Merged with JunoGerm.mesa by Jorge Stolfi May 19, 1984 4:12:07 am PDT
Last Edited by: Jorge Stolfi June 15, 1984 8:17:25 am PDT

This is the top level of an experimental interactive graphics program that allows a user to specify the positions of points by declaring geometrical contraints that the positions are to satisfy. The program solves constraints (which can be viewed as simultaneous polynomial equations) by an n-dimensional version of Newton's method for finding the root of a differentiable function.

JunoTop is the exclusive owner of the internal data structure representing the current image (that is, the points, constraints and actions moused in by the user). It handles those through the JunoImage interface.

JunoTop is also the only module that removes stuff from the user event queue. Things are placed there by (a) the cursor menu module, (b) the image viewer NotifyProc (see JunoUserEventsImpl), and (c) by the JunoButtons module.

TO FIX:

Error recovery: Check it out

JunoAlgebra.Eval: graphics state-pushing ops (paint, width, etc) should restore graphics state on UNWIND

DIRECTORY

JunoImage,
JunoMatrix USING [Matrix, MapCoords, ComputeTransform],
JunoBody USING [Se, MakeBody],
JunoOldSolver USING [Outcome],
JunoStorage USING [Point, Coords, Item, IntCoords, NewPoint, ActionKind, ItemArgs,
ConstrKind, Cons, Frame, NewItem],
JunoExpressions USING [comma, lambda],
JunoAlgebra USING [Value, Call, EvalColor],
JunoGraphics USING [Highight, DrawPoint, PointSymbol,
DrawRope, SetPaperContext, SetScreenContext, DrawEdge, SetFontName,
SetFontFace, SetFontSize, DrawArc, SetJustification, SetColor, black, invert,
currentJustification, currentFontSize, SetCaret, caretOn,
GetRopeDispl, Whiten, SetWidth, Color],
JunoUserEvents USING [bugout, Event, Next, EventCoords, Blink, StartUp, Terminate],
IO USING [PutF, real], -- DEBUG
JunoGlobalAlist USING [AddDef, StartUp, Terminate, ParseAll],
Rope USING [ROPE, FromChar, Cat, IsEmpty, Substr, Length],
Convert USING [RopeFromInt, RopeFromReal],
Process USING[Detach],
Atom USING[GetPName, MakeAtom];

JunoTop: PROGRAM

IMPORTS

JunoImage,
JunoStorage,
JunoBody,
JunoMatrix,
JunoGraphics,
JunoExpressions,
JunoAlgebra,
JunoUserEvents,
JunoGlobalAlist,
IO, -- DEBUG
Rope,
Convert,
Process,
Atom

=

BEGIN

OPEN

JunoStorage,
Im: JunoImage,
Solv: JunoOldSolver,
Body: JunoBody,
Evs: JunoUserEvents,
Gr: JunoGraphics,
Expr: JunoExpressions,
Alg: JunoAlgebra,
Mat: JunoMatrix,
Glob: JunoGlobalAlist,
Rope;

debug1, debug2: BOOL ← FALSE; -- can be set by BugBane to avoid debug output

- - - - ARGUMENT QUEUES

argMax: INTEGER = 50; -- max num. of arguments in each queue

Queue: TYPE = REF QueueRec;

QueueRec: TYPE = RECORD
[top: [0 .. argMax] ← 0,
a: ARRAY [1 .. argMax] OF RECORD
[p: Point, sy: Gr.PointSymbol]];

The symbol used for a point depends on how many points with same rouded coordinates are already there.

que: Queue = NEW[QueueRec];

There used to be a secondary queue, but its duties have been taken over by the primary one.

L1Dist: PROC [p, q: Coords] RETURNS [REAL] = INLINE {RETURN[ABS[p.x-q.x]+ABS[p.y-q.y]]};

HilyteElem: PROC [ix: INTEGER] =
Recomputes a[ix].c and a[ix].sy and paints a[ix].p accordingly.
Assumes it is currently not highlighted.

{OPEN que;
a[ix].sy ← plus;
FOR k: INTEGER DECREASING IN [1..ix) DO
IF L1Dist[a[k].p.coords, a[ix].p.coords] < 1 THEN
{a[ix].sy ← IF a[k].sy >= box THEN box ELSE SUCC[a[k].sy]; EXIT}
ENDLOOP;
Gr.Highight[a[ix].p.coords, a[ix].sy]};

Push: PROC [p: Point] =
Adds p to the "top" end of queue q.
Highlights it as appropriate.

{OPEN que;
IF p=NIL THEN ERROR;
top ← top + 1; a[top].p ← p;
HilyteElem[top]};

Pop: PROC [] =
Removes the oldest ("bottom") point from q.

{OPEN que;
IF top = 0 THEN ERROR;
Gr.Highight[a[1].p.coords, a[1].sy];
FOR i: INTEGER IN [1 .. top) DO
Gr.Highight[a[i+1].p.coords, a[i+1].sy];
a[i] ← a[i + 1];
HilyteElem[i]
ENDLOOP;
top ← top - 1};

RefreshQueue: PROC [] =
Highlights again the points in the argument queue.
Assumes none of them is highlighted. Does not recompute the counts.

{OPEN que;
FOR i: INTEGER IN [1..top] DO
Gr.Highight[a[i].p.coords, a[i].sy]
ENDLOOP};

FlushArgumentQueue: PROC =
Removes (and unpaints) all points from the argument queue.

{OPEN que;
FOR i: INTEGER IN [1 .. top] DO Gr.Highight[a[i].p.coords, a[i].sy] ENDLOOP;
top ← 0};

- - - - MAIN LOOP

The procedures in this section parse the stream of user events (as conditioned by the JunoUserEvents module) and perform the appropriate actions on the current image.

ev: Evs.Event; -- the user event last returned by Evs.Next

Unexpected: SIGNAL = CODE; -- parse/lexer found an event that could't possibly be there

EvCoords: PROCEDURE RETURNS [Coords] = INLINE {RETURN[[ev.coords.x, ev.coords.y]]};

Returns the coordinates of the curent event ev, assuming it is a mouse one (Roll, MouseUp, MouseDown).

MainLoop: PROC =

Parses and executes each user command.

BEGIN

prevCmd: ATOM ← $Missing;

ParseNextCommand: PROC =

Should be called with ev.type = Cursor or Button. Will return with ev.type = End.

ABORTED signals are caught here, if they have not been caught by the individual commands.

BEGIN ENABLE {ABORTED => {GOTO CommandAborted}};

cmd: ATOM = NARROW [ev.value];

Reset image to a reasonably clean state:

ClearPoints: Im.PointVisitProc = {p.wn ← 0; p.fixed ← p.frozen; p.mark ← FALSE};
Im.EnumPoints[ClearPoints];

IF prevCmd # cmd THEN
{FlushArgumentQueue[];
prevCmd ← cmd};

SELECT cmd FROM

$Pencil =>

{ParseCursorCmdBody
[maxPrim: 4, nLeave: 1, Proc: DrawThem]};

$Compass =>

{ParseCursorCmdBody
[maxPrim: 4, nLeave: 2, Proc: CongThem, solve: TRUE]};

$HorTee =>

{ParseCursorCmdBody
[maxPrim: 2, nLeave: 1, Proc: HorThem, solve: TRUE]};

$VerTee =>

{ParseCursorCmdBody
[maxPrim: 2, nLeave: 1, Proc: VerThem, solve: TRUE]};

$Parallels =>

{ParseCursorCmdBody
[maxPrim: 4, nLeave: 2, Proc: ParaThem, solve: TRUE]};

$RightAngle =>

{ParseCursorCmdBody
[maxPrim: 4, nLeave: 2, Proc: PerpThem, solve: TRUE]};

$CallProc =>

{ParseCursorCmdBody
[maxPrim: argMax, Proc: CallProcOnThem,
solve: FALSE, refresh: FALSE]};

$MoveArrow =>

{ParseCursorCmdBody
[maxPrim: argMax, baloonSel: TRUE,
Proc: MoveThem, solve: TRUE]};

$CopyArrow =>

{ParseCursorCmdBody
[maxPrim: argMax, baloonSel: TRUE,
Proc: CopyThem, solve: TRUE]};

$MakeProc =>

{ParseCursorCmdBody
[maxPrim: argMax, baloonSel: TRUE,
Proc: MakeProcOfThem, solve: FALSE, refresh: FALSE]};

$Eraser =>

{ParseCursorCmdBody
[maxPrim: argMax, create: FALSE, baloonSel: TRUE,
Proc: DeleteThem, solve: TRUE]};

$Snowman =>

{ParseFreezeCmd []};

$Typewriter =>

{ParseTypeCmd []};

$Hardcopy =>

{ParseButtonCmdBody
[Proc: DoHardcopy, solve: FALSE, refresh: FALSE]};

$Redraw =>

{ParseButtonCmdBody
[Proc: DoRedraw, solve: FALSE, refresh: TRUE]};

$Solve =>

{ParseButtonCmdBody
[Proc: DoSolve, solve: TRUE]};

$StartOver =>

{ParseButtonCmdBody
[Proc: DoStartOver,
solve: FALSE, refresh: TRUE]};

$LoadX =>

{ParseButtonCmdBody [Proc: DoLoadX, solve: FALSE, refresh: FALSE]};

$Parse =>

{ParseButtonCmdBody [Proc: DoParse, solve: FALSE, refresh: TRUE]};

$SetFont, $SetFontSize, $SetFontFace,
$SetJustification, $SetWidth, $SetColor =>

{ParseButtonCmdBody
[Proc: DoSetOption,
solve: FALSE, refresh: FALSE]};

ENDCASE => {ERROR Unexpected};

IF ev.type # End THEN {ERROR Unexpected} -- command didn't get to End

EXITS

CommandAborted =>

{Evs.Blink["Command aborted!"];
WHILE ev.type # End DO ev ← Evs.Next[] ENDLOOP;
IF Gr.caretOn THEN Gr.SetCaret[on: FALSE];
Refresh[screen: TRUE]}

END;

Body of main loop:

Evs.StartUp[debug: TRUE];
Glob.StartUp[];

DO

ev ← Evs.Next[];
IF ev.type = Quit THEN EXIT;
ParseNextCommand[! ABORTED => CONTINUE] -- in case ABORTED escapes after all

ENDLOOP;

Evs.Terminate[];
Glob.Terminate[]

END;

- - - - TYPICAL CURSOR COMMANDS

CursorCommandProc: TYPE = PROC [terminator: ATOM];

A CursorCommandProc is called by ParseCursorCmdBody to do the actual processing.

The arguments to the CursorCommandProc (i.e., the moused points in that segment) will be in the primary argument queue and/or will have wn#0, depending on how they were selected.

The CursorCommandProc is called only with terminator = $Escape, $Return, or $Tab.

ParseCursorCmdBody: PROC
[maxPrim, nLeave: INT ← 0,
create: BOOL ← TRUE, baloonSel: BOOL ← FALSE,
Proc: CursorCommandProc, solve, refresh: BOOL ← FALSE] =

Parses the body of simple commands acording to the syntax
<mouse clicks> End
where the <mouse clicks> are as accepted by ParseMousedPoints.

On entry, ev should be Cursor or Button. On exit, it will be End.

The nLeave parameter is the number of points to be left on the primary argument queue (eg., nLeave=1 for draw, =2 for cong).

If solve = TRUE and the End-ing event is $Escape or $Return, Proc is called, the constraints are solved again, and the image is repainted. Note that the p.fixed and p.frozen bits may be set by Proc to prevent the solver from moving a point p. The p.fixed bit will be reset before the next user command is executed.

If solve=FALSE or the End-ing event is $Tab, Proc is called, but the constraints are NOT solved. The image will be repainted (with the current positions of the points) if refresh=TRUE.

Finally, if the End-ing event is $Delete or $None, Proc is not called; the argument queues are cleared, and no solving or repainting takes place.

BEGIN

terminator: ATOM;

ParseMousedPoints [maxPrim, create, baloonSel];

IF ev.type # End THEN {ERROR Unexpected};
terminator ← NARROW [ev.value];

SELECT terminator FROM

$None, $Delete => {FlushArgumentQueue[]};

$Escape, $Tab, $Return =>

{Proc[terminator];
WHILE que.top > 0 AND que.top # nLeave DO Pop[] ENDLOOP;
IF solve AND (terminator = $Escape OR terminator = $Return) THEN
{Solve[]; Refresh[screen: TRUE]}
ELSE IF refresh THEN
{Refresh[screen: TRUE]}};

ENDCASE => {ERROR Unexpected};

END;

ParseMousedPoints: PROC
[maxPrim: INT ← 0, create: BOOL ← TRUE, baloonSel: BOOL ← FALSE] =

Parses a sequence of mouse clicks that specifies the arguments to a typical command.

The parsed sequence consists of zero to maxPrim "primary" points (either new ones created with red clicks, or old ones selected with yellow clicks), plus, if baloonSel=TRUE, any number of "baloon-selected" or "wound" points (old ones selected by circling them with the mouse while the blue button is held down). Multiple blue baloons are cumulative. The two kinds of selections may be freely intermixed and may include the same point(s). The order and multiplicity of the primary arguemnts is important in general.

Red clicks (point creation) are allowed only if create=TRUE. All mouse clicks will track the mouse until the button is released.

The least recent entries in the primary queue are automatically removed if the length of the latter exceeds maxPrim. Setting maxPrim to zero disables primary selections.

Should be called with ev= event before point list (i.e., Cursor or Button). On return, ev is End. Events of type Char, Backspace, Atom, Real, and Rope are flagged and ignored.

BEGIN

DO

ev ← Evs.Next[];
SELECT ev.type FROM

MouseDown =>

{SELECT ev.value FROM

$Red =>

{IF create THEN
IF maxPrim <= 0 THEN
{Evs.Blink ["Primary selections not allowed"]}
ELSE
{coords: Coords = ParseMousedCoords[];
Push[AddNewPoint [coords, TRUE]];
Evs.bugout.PutF["ParseMousedPoints: new point at [%g, %g]",
IO.real[coords.x], IO.real[coords.y]]; -- DEBUG
 WHILE que.top > maxPrim DO Pop [] ENDLOOP}
ELSE
{Evs.Blink ["Point creation not allowed"]}};

$Yellow =>

{IF maxPrim <= 0 THEN
{Evs.Blink ["Primary selections not allowed"]}
ELSE
{p: Point = ParseMouseSelectedPoint[wound: FALSE];
IF p # NIL THEN
{Push[p];
Evs.bugout.PutF["ParseMousedPoints: old point at [%g, %g]",
IO.real[p.coords.x], IO.real[p.coords.y]]; -- DEBUG
WHILE que.top > maxPrim DO Pop[] ENDLOOP}}};

$Blue =>

{IF baloonSel THEN
{TrackBlueBaloon[];
IF NOT Im.AnyWoundPoints[] THEN
{Evs.Blink ["Warning - no points selected"]}}
ELSE
{Evs.Blink ["Baloon selections not allowed"]}};

ENDCASE => {SIGNAL Unexpected};

EatMouseTail};

Char, Atom, Rope, Real, BackSpace =>

{Evs.Blink ["Invalid input"]};

End =>

{RETURN};

ENDCASE => {SIGNAL Unexpected};

ENDLOOP;

END;

- - - - TYPICAL BUTTON COMMANDS

ButtonCommandProc: TYPE = PROC [button: ATOM];

A ButtonCommandProc is called by ParseButtonCmdBody to process the body of a typical Button command.

The ButtonCommandProc is called with ev = first button argument (or End if none). It should return with ev=End.

ParseButtonCmdBody: PROC
[Proc: ButtonCommandProc, solve, refresh: BOOL ← FALSE] =

Parses the body of button commands, that obeys the syntax
<button arguments, mouse clicks, and keyboard events> End
where the arguments are as accepted by the given ButtonCommandProc.

On entry, ev should be Cursor or Button. On exit, ev will be the event following the End (next Cursor or Button).

If solve = TRUE, Proc is called, the constraints are solved again, and the image is repainted. Note that the p.fixed and p.frozen bits may be set by the ButtonCommandProc to prevent the solver from moving a point p. The p.fixed bit will be reset before the next user command is executed.

If solve=FALSE, Proc is called, but the constraints are NOT solved. The image will be repainted (with the current positions of the points) if refresh=TRUE.

BEGIN

button: ATOM = NARROW[ev.value];
ev ← Evs.Next[];

Proc[button];
IF ev.type # End THEN {ERROR Unexpected};

IF solve THEN {Solve[]};
IF solve OR refresh THEN {Refresh[screen: TRUE]}

END;

- - - - MOUSE CLICK PARSING

EatMouseTail: PROC =

Skips any leftovers from a mouse click, if any. Should be called with ev.type=MouseDown, Roll, or MouseUp; returns with ev.type = MouseUp.

{WHILE ev.type = Roll OR ev.type = MouseDown DO ev ← Evs.Next[] ENDLOOP;
IF ev.type # MouseUp THEN ERROR Unexpected};

ParseMousedCoords: PROC RETURNS [coords: Coords] =

Parses a <mouse click>, returning its coordinates.

Does not allocate a new Point, and does not affect the argument queue. Will track the mouse continuously, highlighting its current position, until the button is released. On exit, the point is not highlighted.

Should be called with ev=MouseDown. Returns with ev=MouseUp.

{DO
coords ← EvCoords[];
IF ev.type # Roll AND ev.type # MouseDown THEN EXIT;
Gr.Highight[coords, plus];
ev ← Evs.Next[];
Gr.Highight[coords, plus];
ENDLOOP;
IF ev.type # MouseUp THEN ERROR Unexpected};

ParseMouseSelectedPoint: PROC [wound: BOOL ← FALSE] RETURNS [point: Point ← NIL] =

Parses a <mouse click>, returning the point nearest to the clicked coordinates (or NIL if couldn't find such point).

Does not allocate a new Point, and does not affect the argument queue. Will let the selected point track the mouse, highlighting it, until the button is released. The point is not highlighted on exit.

If wound = TRUE, considers only points that have wn#0.

Should be called with ev=MouseDown. Returns with ev=MouseUp.

{DO
point ← Im.FindPoint[coords: EvCoords[], wound: wound];
IF point = NIL THEN
{Evs.Blink ["No point found"];
EatMouseTail[];
RETURN};
IF ev.type # Roll AND ev.type # MouseDown THEN EXIT;
Gr.Highight[point.coords, plus];
ev ← Evs.Next[];
Gr.Highight[point.coords, plus]
ENDLOOP;
IF ev.type # MouseUp THEN ERROR Unexpected};

TrackBlueBaloon: PROCEDURE =

The effect of TrackBlueBaloon is to track the cursor until the Blue button is released, setting the wn (winding number) field for all image points contained in the loop made by the cursor.

Should be called with ev.type = $BlueDown. Returns with ev = $BlueUp.

BEGIN

prev: IntCoords;

NextBluePoint: Im.NextPointProc =

BEGIN
-- Waits for the mouse to move far enough, or blue button to go up,
-- and returns its coordinates.
 DO
ev ← Evs.Next[];
IF ev.type # Roll AND ev.type # MouseUp THEN {SIGNAL Unexpected; LOOP};
lastPoint ← ev.type = MouseUp;
IF lastPoint
OR ABS[ev.coords.x - prev.x] > 5 OR ABS[ev.coords.y - prev.y] > 5 THEN
{coords ← ev.coords; Gr.DrawPoint[EvCoords[]]; RETURN}
ENDLOOP
END;

prev ← ev.coords;
Gr.DrawPoint[EvCoords[]];
Im.BaloonSelect[prev, NextBluePoint]

END;

- - - - IMAGE CONSTRUCTION

pointCount: INTEGER ← 0; -- counts Points created since last StartOver, for debugging

AddNewPoint: PUBLIC PROC [coords: Coords, visible: BOOL ← TRUE] RETURNS [p: Point] =

BEGIN
p ← NewPoint[coords, visible];
pointCount ← pointCount+1;
p.name ← NthName[n: pointCount, prefix: "P"];
IF visible THEN Gr.DrawPoint[p.coords];
Im.AddPoint[p]
END;

AddNewAction: PROC [kind: ActionKind, args: ItemArgs, doIt: BOOL ← FALSE] =

BEGIN

IF doIt THEN ExecuteAction[kind: kind, args: args ! ABORTED => {GOTO SkipIt}];
Im.AddItem [NewItem [kind: kind, args: args]];

EXITS

SkipIt => {}

END;

AddNewConstr: PROC [kind: ConstrKind, args: ItemArgs, doIt: BOOL ← FALSE] =

BEGIN

Im.AddItem [NewItem [kind: kind, args: args]];

END;

- - - - CONSTRAINTS

CongThem: CursorCommandProc =

BEGIN
IF que.top # 4 THEN
{WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{AddNewConstr[kind: cong, args: LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p]]}
END;

ParaThem: CursorCommandProc =

BEGIN
IF que.top # 4 THEN
{WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{AddNewConstr[kind: para, args: LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p]]}
END;

PerpThem: CursorCommandProc =

BEGIN
IF que.top # 4 THEN
{WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{AddNewConstr[kind: perp, args: LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p]]}
END;

HorThem: CursorCommandProc =

BEGIN
IF que.top # 2 THEN
{WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{AddNewConstr[kind: perp, args: LIST[que.a[1].p, que.a[2].p]]}
END;

VerThem: CursorCommandProc =

BEGIN
IF que.top # 2 THEN
{WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{AddNewConstr[kind: perp, args: LIST[que.a[1].p, que.a[2].p]]}
END;

- - - - DRAW COMMAND

DrawThem: CursorCommandProc =

BEGIN
IF que.top = 3 OR que.top = 1 THEN Pop[];
IF que.top = 0 THEN
{RETURN}
ELSE
{AddNewAction
[kind: draw,
args: IF que.top = 2
THEN LIST[que.a[1].p, que.a[2].p]
ELSE LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p],
doIt: TRUE]}
END;

- - - - ERASE COMMAND

DeleteThem: CursorCommandProc =

BEGIN
FOR i: INTEGER IN [1..que.top] DO que.a[i].p.wn ← 1 ENDLOOP;
FlushArgumentQueue[];
Im.DeleteWoundItems[]
END;

- - - - CALL PROCEDURE COMMAND

currentX: ATOM ← $X;

DoLoadX: ButtonCommandProc =

{currentX ← NARROW[ev.value]; ev ← Evs.Next[]};

DoParse: ButtonCommandProc =

{Glob.ParseAll[]};

CallProcOnThem: CursorCommandProc =

BEGIN

args: ItemArgs ← NIL;
FOR i: INTEGER DECREASING IN [1 .. que.top] DO
args ← Cons[que.a[i].p, args]
ENDLOOP;
-- Glob.ParseAll[];
{FixIt: Im.PointVisitProc={p.fixed ← TRUE}; Im.EnumPoints[FixIt]};
AddNewAction [kind: call, args: Cons[currentX, args], doIt: TRUE]

END;

- - - - MAKE PROCEDURE COMMAND

NthName: PROC [n: INTEGER, prefix: ROPE ← NIL] RETURNS [name: ATOM] =
Generates the nth standard point name: a (n=0), b, c, ...,z, a1, b1, ..., a2, ..., z9, a10, b10, ...
The given prefix is concatenated in front of these names.

BEGIN
letter: ROPE = Rope.FromChar['a + n MOD 26];
number: ROPE = IF n > 25 THEN Convert.RopeFromInt[n/26, 10, FALSE] ELSE NIL;
RETURN[Atom.MakeAtom[Rope.Cat [prefix, letter, number]]]
END;

procCount: INTEGER ← 0; -- number of procedures created so far

MakeProcOfThem: CursorCommandProc =

BEGIN

np: INTEGER ← 0; -- number of points named so far

NamePoint: Im.PointVisitProc =

{p.name ← NthName[np]; np ← np+1;
Gr.DrawRope[[p.coords.x + 5, p.coords.y + 5], Atom.GetPName[p.name]]};

formals, body, proc: Body.Se;

frame: Frame;

Erase all point names, and reset their fixed flag:

{UnNam: Im.PointVisitProc={p.name←NIL; p.fixed←FALSE}; Im.EnumPoints [UnNam]};

Name the formal parameters, make a nest of them, and mark them as fixed:

IF que.top = 0 THEN
{formals ← NIL}
ELSE
{NestEm: PROC [i: INTEGER] RETURNS [f: Body.Se] =
{p: Point = que.a[i].p;
IF p.name # NIL THEN {Evs.Blink["Repeated formal parameter"]; ERROR};
NamePoint[p];
p.fixed ← TRUE;
formals ← IF i=que.top
THEN p.name
ELSE LIST[Expr.comma, p.name, NestEm[i+1]]};

formals ← NestEm[1]};

Get reference frame for local hints:

frame ←
[org: IF que.top > 0 THEN que.a[1].p ELSE NIL,
hor: IF que.top > 1 THEN que.a[2].p ELSE NIL,
ver: IF que.top > 2 THEN que.a[3].p ELSE NIL];

Name the other points :

{NameWnd: Im.PointVisitProc = {IF p.wn#0 AND p.name = NIL THEN NamePoint[p]};
Im.EnumPoints [NameWnd]};

Build the body of the lambda:

body ← Body.MakeBody[frame];

Build the lambda and add it to the list:

proc ← LIST [Expr.lambda, formals, body];
procCount ← procCount+1;
currentX ← Atom.MakeAtom[Rope.Cat
["X", Convert.RopeFromInt[procCount, 10, FALSE]]];
Glob.AddDef [name: currentX, value: proc]

END;

- - - - FREEZE COMMAND

ParseFreezeCmd: PROC =

BEGIN

HilyteIfFrozen: Im.PointVisitProc =

{IF p.frozen THEN Gr.Highight[p.coords, diamond]};

Im.EnumPoints[HilyteIfFrozen]; -- Highlight currently frozen points

DO

ev ← Evs.Next[];
SELECT ev.type FROM

MouseDown =>

{p: Point;
SELECT ev.value FROM
$Red =>
{coords: Coords = ParseMousedCoords[];
p ← AddNewPoint [coords, TRUE]};
$Yellow =>
{p ← ParseMouseSelectedPoint[wound: FALSE]};
$Blue =>
{Evs.Blink ["Red or yellow button, please"]};
ENDCASE => ERROR Unexpected;
IF p # NIL THEN
{p.frozen ← NOT(p.frozen);
p.fixed ← p.frozen;
Gr.Highight[p.coords, diamond]};
EatMouseTail};

Char, BackSpace, Atom, Rope, Real =>

{Evs.Blink ["Invalid input"]};

End =>

{IF ev.value = $Escape THEN
{Solve[]; Refresh[screen: TRUE]}
ELSE IF ev.value # $Tab AND ev.value # $None THEN
{Evs.Blink ["Invalid input"]};
EXIT};

ENDCASE => {ERROR Unexpected};

ENDLOOP;

Im.EnumPoints[HilyteIfFrozen] -- Erase all highlights

END;

- - - - MOVE AND COPY COMMANDS

MoveThem: CursorCommandProc =

BEGIN
MoveOrCopyThem[copy: FALSE]
END;

CopyThem: CursorCommandProc =

BEGIN
MoveOrCopyThem[copy: TRUE]
END;

mat: REF Mat.Matrix ← NEW [Mat.Matrix]; -- transform matrix for move/copy commands

MoveOrCopyThem: PROC [copy: BOOLEAN] =

A procedure used in both the Move and Copy commands.

The primary arguments should come in one or more pairs (from, to). If there are no baloon-selected points, then all "from" points are moved to the corresponding "to" points.
If there are blue-selected points, then only these are moved, according to an affine transformation specified by the primary arguments. The latter must come in one to three pairs; the transformation is the one mapping the "from" points into the "to" ones.

If copy=TRUE, the points to be moved are first duplicated, and the motion appied to the copies. All constraints and actions that involve only copied points are copied as well.

In either case, when a "from" point moves and the corresponding "to" doesn't, the two are replaced by a single point in all actions and constraints where they occurs.

The motion occurs irrespective of the frozen/unfrozen status of the selected points. After the motion, the points that were moved will be temporarily fixed in their new positions, till the next command.

This procedure assumes all copy links are NIL on entry, all points in the source frame have wn#0, and all points in the destination frame have wn=0.

BEGIN

n: INTEGER = que.top/2;
singular: BOOL ← FALSE;
baloon: BOOL = Im.AnyWoundPoints[];

MoveIt: PROC [p: Point, c: Coords] = INLINE
{p.coords ← c; p.wn ← 0; p.fixed ← TRUE};

IF que.top MOD 2 # 0 OR que.top=0 THEN
{Evs.Blink["Please select one or more pairs (from, to)"]; RETURN};

If there are blue-selected points, then the points on the argument queue must be a pair of interleaved frames specifying a non-singular affine transformation. If not, the "from" points in the queue are automatically blue-selected for copying.

IF baloon THEN
{OPEN que;
from, to: Frame ← [NIL, NIL, NIL];
IF top > 6 THEN
{Evs.Blink["Reference frames may have at most three pairs of points"]; RETURN};
from.org ← a[1].p; to.org ← a[2].p;
IF n>1 THEN {from.hor ← a[3].p; to.hor ← a[4].p};
IF n>2 THEN {from.ver ← a[5].p; to.ver ← a[6].p;
[mat, singular] ← Mat.ComputeTransform[from, to, mat];
IF singular THEN
{Evs.Blink["Singular transformation"]; RETURN}}}
ELSE
{FOR i: INTEGER 𡤁, i+2 WHILE i<que.top DO
que.a[i].p.wn ← 1
ENDLOOP};

If copy, duplicate all points to be moved and apply the move to them.

IF copy THEN
BEGIN

Im.DuplicateWoundItems[];

Im.DuplicateWoundItems will
a) copy the points with wn#0 (& attached constraints &actions);
b) add the copies to the current image,
c) set the copy link of the originals to the copies,
d) set the copy links of the copies to NIL,
e) set the wn's of the copies to the wn's of the originals,
f) set the wn's of the originals to zero
(i.e. take out the originals from the baloon, and put in the copies).

Now replace all "from" points in the queue by their copies

FOR i: INTEGER ← 1, i+2 WHILE i<que.top DO
IF que.a[i].p.copy # NIL THEN
{que.a[i].p ← que.a[i].p.copy}
ENDLOOP;

Now reset copy links of all points

{Reset: Im.PointVisitProc = {p.copy ← NIL}; Im.EnumPoints[Reset]};

END;

Forcefully move every "from" point with wn#0 to the corresponding "to" point, and identify the two (unless the "to" point moves, too).

FOR i: INTEGER ← 1, i+2 WHILE i < que.top DO
from: Point = que.a[i].p;
to: Point = que.a[i+1].p;
IF from.wn#0 THEN
{MoveIt[from, to.coords];
IF to.wn = 0 THEN
{from.copy ← to}}
ENDLOOP;
Im.IdentifyPoints[];

Move the remaining wound points according to the affine transformation.

IF baloon THEN
{Map: Im.PointVisitProc = {IF p.wn#0 THEN MoveIt[p, Mat.MapCoords[p.coords, mat]]};
Im.EnumPoints [Map];
Im.SortPoints[]};

END;

- - - - TYPEIN COMMAND

oldRope: ROPE ← NIL; -- last type-in, for defaulting

refPos: Coords; -- reference coordinates for string currently being parsed
refPoint: Point ← NIL; -- if refPos was yellow-selected, this is the selected point, else it is NIL
refPosDefined: BOOL ← FALSE; -- if FALSE, refPos is not defined - user must give it

ParseTypeCmd: PROC =

BEGIN

rope: ROPE ← NIL; -- typein collected so far

ParseRefPos: PROC =
Parses a red/yellow click, returns it in refPos (and refPoint if old).
To be called with ev.type = MouseDown, returns with ev.type=MouseUp.
sets refPosDefined (unless failed to find the point).

BEGIN

SELECT ev.value FROM

$Red =>

{refPos ← ParseMousedCoords[];
Gr.SetCaret [coords: refPos];
refPosDefined ← TRUE};

$Yellow =>

{p: Point = ParseMouseSelectedPoint[];
IF p # NIL THEN
{refPos ← p.coords; refPoint ← p;
Gr.SetCaret [coords: refPos];
refPosDefined ← TRUE}};

$Blue =>

{Evs.Blink ["Red or yellow button, please"]};

ENDCASE => {ERROR Unexpected};

END;

ChangeRope: PROC [new: ROPE] =
Replace rope by new and repaints it. Assumes caret is on.

BEGIN

IF NOT rope.IsEmpty[] THEN
{Gr.DrawRope[refPos, rope]}; -- erase old rope
rope ← new;
Gr.DrawRope[refPos, rope]; -- paint new one
IF Gr.currentJustification # $right THEN
{-- must move caret
 vec: Coords ← Gr.GetRopeDispl [rope];
IF Gr.currentJustification = $center THEN {vec ← [0.5*vec.x, 0.5*vec.y]};
Gr.SetCaret [coords: [refPos.x+vec.x, refPos.y+vec.y]]};

END;

AddTheRope: PROC =
Adds the current rope to the current image at the current refPoint, or, if refPoint is NIL, at a newly created point with coords= refPos. Then sets oldRope ← rope, rope ← NIL, refPoint ← NIL. Assumes refPosDefined is TRUE on entry.

BEGIN

oldRope ← rope; -- save oldRope in case user just hits ESC next time
-- create new point, if needed
IF refPoint = NIL THEN
{refPoint ← AddNewPoint [coords: refPos, visible: FALSE]};
-- add print action
AddNewAction [kind: print, args: LIST [rope, refPoint], doIt: FALSE];
rope ← NIL;
refPoint ← NIL;

END;

Body of parseTypeCmd:

BEGIN

IF refPosDefined THEN Gr.SetCaret [coords: refPos];
[] ← Gr.SetColor[Gr.invert];

DO

ev ← Evs.Next[];

SELECT ev.type FROM

Char, Rope, Atom, BackSpace, Real =>

{IF NOT refPosDefined THEN
{Evs.Blink ["Please select reference point"]}
ELSE
{new: ROPE = SELECT ev.type FROM
Char => rope.Cat [FromChar[NARROW[ev.value, REF CHAR]^]],
BackSpace => IF rope.IsEmpty THEN rope ELSE
rope.Substr [0, rope.Length[] - 1],
Rope => NARROW[ev.value, ROPE],
Real => Convert.RopeFromReal[NARROW[ev.value, REF REAL]^],
Atom => Atom.GetPName[NARROW[ev.value, ATOM]],
ENDCASE => ERROR;
ChangeRope[new]}};

MouseDown =>

{IF NOT rope.IsEmpty THEN AddTheRope;
ParseRefPos;
IF refPosDefined THEN Gr.SetCaret [on: TRUE, coords: refPos]};

End =>

{IF ev.value = $Delete THEN
{ChangeRope[NIL]};
IF rope.IsEmpty[]
AND NOT oldRope.IsEmpty[]
AND ev.value=$Escape THEN {ChangeRope[oldRope]};
IF NOT rope.IsEmpty THEN AddTheRope;
IF Gr.caretOn THEN Gr.SetCaret [on: FALSE];
IF ev.value = $Return THEN
{refPos ← [refPos.x, refPos.y - Gr.currentFontSize];
refPosDefined ← TRUE}
ELSE IF ev.value # $Delete THEN
{refPosDefined ← FALSE};
RETURN};

ENDCASE => {ERROR Unexpected};

ENDLOOP

END

END;

- - - - CONSTRAINT SOLVING AND IMAGE REFRESH

Solve: PROC =
Solves the current set of constraints for all points that have p.fixed=FALSE. Does not repaint the screen; client should call Refresh as soon as possible.

BEGIN
SELECT Im.SolveImage[0.1] FROM
true => {};
uncertain => {Evs.Blink["The solver didn't converge."]};
false => {Evs.Blink["The solver failed."]};
ENDCASE
END;

Refresh: PROCEDURE [screen: BOOL ← TRUE] =
Repaints the current image on the current context (screen or hardcopy).
Will set p.fixed=TRUE for all points, so that procedure calls will not move them
(except by assignment).
If screen=FALSE, will paint on the current context, and will show only actions (no poinrs and no argument queue highlights).

BEGIN
FixIt: Im.PointVisitProc={p.fixed ← TRUE};
DoIt: Im.ItemVisitProc =
{IF item.kind IN ActionKind THEN
ExecuteAction [item.kind, item.args ! ABORTED => CONTINUE]};
ShowIt: Im.PointVisitProc = {IF p.visible THEN Gr.DrawPoint [p.coords]};

IF screen THEN
{Gr.SetScreenContext[]; Gr.Whiten[]};
-- Glob.ParseAll[]; -- -- update global a-list
 [] ← Gr.SetColor[Gr.black];
Im.EnumPoints[FixIt];
Im.EnumItems[DoIt];
IF screen THEN
{Im.EnumPoints[ShowIt];
[] ← Gr.SetColor[Gr.invert];
RefreshQueue[]}
END;

- - - - ACTION SEMANTICS

ExecuteAction: PUBLIC PROC [kind: ActionKind, args: ItemArgs] =

Before calling this procedure, the client must make sure the global ALIst is up-to-date (by calling Glob.ParseAll).

BEGIN
SELECT kind FROM

draw =>

{IF args.rest.rest=NIL THEN
{p: Coords = NARROW [args.first, Point].coords;
q: Coords = NARROW [args.rest.first, Point].coords;
Gr.DrawEdge[p, q, FALSE]}
ELSE
{p: Coords = NARROW [args.first, Point].coords;
r: Coords = NARROW [args.rest.first, Point].coords;
s: Coords = NARROW [args.rest.rest.first, Point].coords;
q: Coords = NARROW [args.rest.rest.rest.first, Point].coords;
Gr.DrawArc[p, r, s, q, FALSE]}};

print =>

{rope: Rope.ROPE = NARROW[args.first];
p: Point = NARROW[args.rest.first];
Gr.DrawRope [coords: p.coords, rope: rope]};

call =>

{Alg.Call[func: NARROW[args.first], args: NARROW [args.rest]
! ABORTED => CONTINUE];
Im.SortPoints[]};

font =>

{font: ROPE = NARROW[args.first];
[] ← Gr.SetFontName[font]};

face =>

{face: ATOM = NARROW[args.first];
[] ← Gr.SetFontFace[face]};

size =>

{size: REAL = NARROW[args.first, REF REAL]^;
[] ← Gr.SetFontSize[size]};

paint =>

{color: Gr.Color = Alg.EvalColor[args.first, NIL];
[] ← Gr.SetColor[color]};

width =>

{width: REAL = NARROW[args.first, REF REAL]^;
[] ← Gr.SetWidth[width]};

justified =>

{justification: ATOM = NARROW[args.first];
[] ← Gr.SetJustification[justification]};

ENDCASE =>

{ERROR};

END;

- - - - BUTTON PROCEDURES

The following procedures are called via PArseButtonCmd.

DoHardcopy: ButtonCommandProc =

Should be called with solve=FALSE, refresh=FALSE.

{filename: Rope.ROPE = NARROW [ev.value];
device: ATOM;
ev ← Evs.Next[];
IF ev.type # Atom THEN SIGNAL Unexpected;
device ← NARROW[ev.value]; ev ← Evs.Next[];
Evs.Blink["creating PD file ", filename, " for ", Atom.GetPName[device]];
Gr.SetPaperContext[device, filename];
Refresh[screen: FALSE];
Evs.Blink["PD file created."];
Gr.SetScreenContext[]};

DoRedraw: ButtonCommandProc = {};

Should be called with solve=FALSE, refresh=TRUE.

DoSolve: ButtonCommandProc = {};

Should be called with solve=TRUE

DoStartOver: ButtonCommandProc =

Should be called with solve=FALSE, refresh=TRUE.

{Im.PurgeImage [];
[] ← Gr.SetJustification[$left];
oldRope ← NIL};

DoSetOption: ButtonCommandProc =

Used by the buttons SetFontName, SetFontSize, SetFontFace, etc.

Should be called with solve=FALSE, refresh=FALSE.

{kind: ActionKind = SELECT button FROM
$SetFont => font,
$SetFontSize => size,
$SetFontFace => face,
$SetJustification => justified,
$SetWidth => width,
$SetColor => paint,
ENDCASE => ERROR;
args: ItemArgs = Cons[ev.value, NIL];
ev ← Evs.Next[];
AddNewAction [kind: kind, args: args, doIt: TRUE]};

- - - - INITIALIZATION:

Process.Detach[FORK MainLoop[]]

END.